Access.hs

-- | Functions for accessing the values of enumerations including 
-- compatability with the property based testing frameworks QuickCheck and
-- SmallCheck.
module Test.Feat.Access(
  -- ** Accessing functions
  index,
  values,
  striped,
  bounded,
  
  -- ** A simple property tester
  ioFeat,
  ioAll,
  ioBounded,
  
  -- ** Compatability
  -- *** QuickCheck
  uniform,
  -- *** SmallCheck
  toSeries,
  
  -- ** Non-class versions of the access functions
  valuesWith,
  stripedWith,
  boundedWith,
  uniformWith,
  toSeriesWith
  )where

-- testing-feat
import Test.Feat.Enumerate 
import Test.Feat.Class
-- base
import Data.List
-- quickcheck
import Test.QuickCheck
-- smallcheck
-- import Test.SmallCheck.Series -- Not needed

group :: Enumerate a -> Part -> Index -> Integer
group e p i = sum (map (card e) [0..p-1]) + i

split :: Enumerate a -> Integer -> (Part, Index)
split e i0 = go i0 0 where
  go i p = let crd = card e p in 
     if i < crd then (p,i)
     else go (i-crd) (p+1)

-- | Mainly as a proof of concept we can use the isomorphism between 
-- natural numbers and (Part,Index) pairs to index into a type
-- May not terminate for finite types.
-- Might be slow the first time it is used with a specific enumeration 
-- because cardinalities need to be calculated.
-- The computation complexity after cardinalities are computed is a polynomial
-- of the size of the resulting value.
index :: Enumerate a -> Integer -> a 
index e = uncurry (select e) . split e

-- | All values of the enumeration by increasing cost (which is the number
-- of constructors for most types). Also contains the cardinality of each list.
values :: Enumerable a => [(Integer,[a])]
values = valuesWith optimised

-- | A generalisation of @values@ that enumerates every nth value of the 
-- enumeration from a given starting point.
-- As a special case @values = striped 0 0 1@.
striped ::  Enumerable a => Part -> Index -> Integer -> [(Integer,[a])]
striped = stripedWith optimised 

-- | A version of vales that has a limited number of values in each inner list.
-- If the list corresponds to a Part which is larger than the bound it evenly
-- intersperses the values across the enumeration of the Part.
bounded :: Enumerable a => Integer -> [(Integer,[a])]
bounded = boundedWith optimised

-- | A rather simple but general property testing driver.
-- The property is a (funcurried) IO function that both tests and reports the 
-- error. The driver goes on forever or until the list is exhausted, 
-- reporting the coverage and the number of
-- tests before each new part.
ioFeat :: [(Integer,[a])] -> (a -> IO ()) -> IO ()
ioFeat vs f = go vs 0 where
  go ((c,xs):xss) s = do
    putStrLn $ "--- Testing "++show c++" vales at size " ++ show s
    mapM f xs
    go xss (s+1)
  go []           s = putStrLn $ "--- Done. Tested "++ show s++" values"

-- | ioAll = 'ioFeat' values
ioAll :: Enumerable a => (a -> IO ()) -> IO ()
ioAll = ioFeat values

-- | ioBounded @n = 'ioFeat' (bounded n)@
ioBounded :: Enumerable a => Integer -> (a -> IO ()) -> IO ()
ioBounded n = ioFeat (bounded n)



-- | Compatability with QuickCheck. Distribution is uniform generator over 
-- values bounded by the given size. Typical use: @sized uniform@.
uniform :: Enumerable a => Int -> Gen a
uniform = uniformWith optimised

-- | Compatability with SmallCheck. 
toSeries :: Enumerable a => Int -> [a] 
toSeries = toSeriesWith optimised

-- | Non class version of 'values'.
valuesWith :: Enumerate a -> [(Integer,[a])]
valuesWith e = 
  [(crd,[select e p i|i <- [0..crd - 1]]) 
    |p <- [0..], let crd = card e p]

-- | Non class version of 'striped'.
stripedWith :: Enumerate a -> Part -> Index -> Integer -> [(Integer,[a])]
stripedWith e p o step = if space <= 0 
  then (0,[]) : stripedWith e (p+1) (o - crd) step
  else (d,thisP) : stripedWith e (p+1) (step-m-1) step
  where
    thisP = 
      [select e p x|x <- genericTake d $ iterate (+step) o]
    space = crd - o
    (d,m) = divMod space step
    crd = card e p

-- | Non class version of 'bounded'.
boundedWith :: Enumerate a -> Integer -> [(Integer,[a])]
boundedWith e n = map (samplePart e n) [0..]

samplePart :: Enumerate a -> Index -> Part -> (Integer,[a])
samplePart e m p = 
  let
    top   =  toRational $ (card e p) - 1
    step  =  top / toRational (m-1) 
    crd = card e p
  in if toRational m >= top 
       then (crd, map (select e p) [0..crd - 1])
       else let d = floor ((toRational crd)/ step) in 
         (d+1,[select e p (round (k * step))|k <- map toRational [0..d]])

-- | Non class version of 'uniform'.
uniformWith :: Enumerate a -> Part -> Gen a
uniformWith e maxp = let
  cards  = [(card e x, x) | x <- [maxp, maxp-1 .. 0]]
  tot    = sum $ fst $ unzip cards
  in if tot == 0 then uniformWith e (maxp+1) else do
    i <- choose (0,tot-1)
    return $ uncurry (select e) (lu i cards)
  where
    lu i ((crd,p):xs)  = if i<crd 
      then (p,i) 
      else lu (i-crd) xs
      
-- | Non class version of 'toSeries'.
toSeriesWith :: Enumerate a -> Int -> [a]
toSeriesWith e d = concat (take (d+1) $ map snd $ valuesWith e)