-- | Functions for accessing the values of enumerations including
-- compatibility with the property based testing framework QuickCheck
module Test.Feat.Access(
  -- * Accessing functions
  optimal,
  index,
  select,
  values,

  -- * QuickCheck Compatibility
  uniform,
  
  -- * Combinators
  skipping,
  bounded,
  sizeRange,

  -- * Non-class versions of the access functions
  indexWith,
  selectWith,
  valuesWith,
  uniformWith
  )where

import Test.Feat.Enumerate
import Control.Enumerable
--import Data.Modifiers

-- base
import Data.Ratio((%))


-- quickcheck
import Test.QuickCheck(choose,Gen)

-- | Memoised enumeration. Note that all cardinalities are kept in memory until your program terminates. 
optimal :: Enumerable a => Enumerate a
optimal :: Enumerate a
optimal = Enumerate a
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global

-- | Index into an enumeration. Mainly used for party tricks (give it a really large number), since usually you want to distinguish values by size.
index :: Enumerable a => Integer -> a
index :: Integer -> a
index = Enumerate a -> Integer -> a
forall a. Enumerate a -> Integer -> a
indexWith Enumerate a
forall a. Enumerable a => Enumerate a
optimal

-- | A more fine grained version of index that takes a size and an
-- index into the values of that size. @select p i@ is only defined 
-- for @i@ within bounds (meaning @i < fst (values !! p)@).
select :: Enumerable a => Int -> Index -> a
select :: Int -> Integer -> a
select = Enumerate a -> Int -> Integer -> a
forall a. Enumerate a -> Int -> Integer -> a
selectWith Enumerate a
forall a. Enumerable a => Enumerate a
optimal

{-
-- Not too happy with this phantom argument
countThese :: Enumerable a => a -> Int -> Integer
countThese x k = help x (drop k $ parts optimal) where
   help :: a -> [Finite a] -> Integer
   help _ []    = 0
   help _ (f:_) = fCard f
-}
   
-- | All values of the enumeration by increasing cost (which is the number
-- of constructors for most types). Also contains the length of each list.
values :: Enumerable a => [(Integer,[a])]
values :: [(Integer, [a])]
values = Enumerate a -> [(Integer, [a])]
forall a. Enumerate a -> [(Integer, [a])]
valuesWith Enumerate a
forall a. Enumerable a => Enumerate a
optimal


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

-- | Non class version of 'index'.
indexWith :: Enumerate a -> Integer -> a
indexWith :: Enumerate a -> Integer -> a
indexWith Enumerate a
e Integer
i0 = [Finite a] -> Integer -> a
forall p. [Finite p] -> Integer -> p
go (Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts Enumerate a
e) Integer
i0 where
  go :: [Finite p] -> Integer -> p
go (Finite Integer
crd Integer -> p
ix : [Finite p]
ps)  Integer
i  = if Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
crd then Integer -> p
ix Integer
i else [Finite p] -> Integer -> p
go [Finite p]
ps (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
crd)
  go []                    Integer
_  = [Char] -> p
forall a. HasCallStack => [Char] -> a
error ([Char] -> p) -> [Char] -> p
forall a b. (a -> b) -> a -> b
$ [Char]
"index out of bounds: "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Integer -> [Char]
forall a. Show a => a -> [Char]
show Integer
i0


-- | Non class version of 'select'
selectWith :: Enumerate a -> Int -> Index -> a
selectWith :: Enumerate a -> Int -> Integer -> a
selectWith Enumerate a
e Int
p Integer
i = Finite a -> Integer -> a
forall a. Finite a -> Integer -> a
fIndex (Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts Enumerate a
e  [Finite a] -> Int -> Finite a
forall a. [a] -> Int -> a
!! Int
p) Integer
i


-- | Non class version of 'values'.
valuesWith :: Enumerate a -> [(Integer,[a])]
valuesWith :: Enumerate a -> [(Integer, [a])]
valuesWith = (Finite a -> (Integer, [a])) -> [Finite a] -> [(Integer, [a])]
forall a b. (a -> b) -> [a] -> [b]
map Finite a -> (Integer, [a])
forall a. Finite a -> (Integer, [a])
fromFinite ([Finite a] -> [(Integer, [a])])
-> (Enumerate a -> [Finite a]) -> Enumerate a -> [(Integer, [a])]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts

-- | Non class version of 'uniform'.
uniformWith :: Enumerate a -> Int -> Gen a
uniformWith :: Enumerate a -> Int -> Gen a
uniformWith = [Finite a] -> Int -> Gen a
forall a. [Finite a] -> Int -> Gen a
uni ([Finite a] -> Int -> Gen a)
-> (Enumerate a -> [Finite a]) -> Enumerate a -> Int -> Gen a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts where
  uni :: [Finite a] -> Int -> Gen a
  uni :: [Finite a] -> Int -> Gen a
uni  []  Int
_     =  [Char] -> Gen a
forall a. HasCallStack => [Char] -> a
error [Char]
"uniform: empty enumeration"
  uni  [Finite a]
ps  Int
maxp  =  let  ([Finite a]
incl, [Finite a]
rest)  = Int -> [Finite a] -> ([Finite a], [Finite a])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
maxp [Finite a]
ps
                         f :: Finite a
f             = [Finite a] -> Finite a
forall a. Monoid a => [a] -> a
mconcat [Finite a]
incl
    in  case Finite a -> Integer
forall a. Finite a -> Integer
fCard Finite a
f of
          Integer
0  -> [Finite a] -> Int -> Gen a
forall a. [Finite a] -> Int -> Gen a
uni [Finite a]
rest Int
1
          Integer
_  -> do  Integer
i <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0,Finite a -> Integer
forall a. Finite a -> Integer
fCard Finite a
f Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
                    a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Finite a -> Integer -> a
forall a. Finite a -> Integer -> a
fIndex Finite a
f Integer
i)

                    
-- | Enumerates every nth value of the enumeration from a given starting index.
-- As a special case @striped 0 1@ gives all values (starts at index 0 and takes steps of 1).
--
-- Useful for running enumerations in parallel since e.g. @striped 0 2@ is
-- disjoint from @striped 1 2@ and the union of the two cover all values.
skipping :: Enumerate a -> Index -> Integer -> Enumerate a
skipping :: Enumerate a -> Integer -> Integer -> Enumerate a
skipping Enumerate a
_ Integer
o0 Integer
step | Integer
step Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 Bool -> Bool -> Bool
|| Integer
o0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> Enumerate a
forall a. HasCallStack => [Char] -> a
error [Char]
"skippingWith: invalid argument"
skipping Enumerate a
e Integer
o0 Integer
step = [Finite a] -> Enumerate a
forall a. [Finite a] -> Enumerate a
fromParts ([Finite a] -> Enumerate a) -> [Finite a] -> Enumerate a
forall a b. (a -> b) -> a -> b
$ Integer -> [Finite a] -> [Finite a]
forall a. Integer -> [Finite a] -> [Finite a]
go Integer
o0 (Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts Enumerate a
e) where
   go :: Integer -> [Finite a] -> [Finite a]
go Integer
_ []      = []
   go Integer
o [Finite a]
_       | Integer
o Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> [Finite a]
forall a. HasCallStack => [Char] -> a
error [Char]
"negative"
   go Integer
o (Finite a
p:[Finite a]
ps)  = Finite a
p' Finite a -> [Finite a] -> [Finite a]
forall a. a -> [a] -> [a]
: Integer -> [Finite a] -> [Finite a]
go Integer
o' [Finite a]
ps where -- error (show (space,take,o')) : 
     space :: Integer
space = Finite a -> Integer
forall a. Finite a -> Integer
fCard Finite a
p Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
o
     (Integer
nTake,Integer
o') | Integer
space Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0   = (Integer
0,Integer
oInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Finite a -> Integer
forall a. Finite a -> Integer
fCard Finite a
p)
                | Integer
space Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
step = (Integer
1,Integer
stepInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
space)
                | Bool
otherwise    = (Integer
space Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`quotRem` Integer
step)
     p' :: Finite a
p' = Finite :: forall a. Integer -> (Integer -> a) -> Finite a
Finite{fCard :: Integer
fCard = Integer
nTake 
          , fIndex :: Integer -> a
fIndex = \Integer
i -> Finite a -> Integer -> a
forall a. Finite a -> Integer -> a
fIndex Finite a
p (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
step Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
o)}

-- | A version of values with a limited number of values in each inner list.
-- If the list corresponds to a Part which is larger than the bound it evenly
-- distributes the values across the enumeration of the Part.
bounded :: Enumerate a -> Integer -> Enumerate a
bounded :: Enumerate a -> Integer -> Enumerate a
bounded Enumerate a
e Integer
n = [Finite a] -> Enumerate a
forall a. [Finite a] -> Enumerate a
fromParts ([Finite a] -> Enumerate a) -> [Finite a] -> Enumerate a
forall a b. (a -> b) -> a -> b
$ (Finite a -> Finite a) -> [Finite a] -> [Finite a]
forall a b. (a -> b) -> [a] -> [b]
map (Integer -> Finite a -> Finite a
forall a. Integer -> Finite a -> Finite a
samplePart Integer
n) ([Finite a] -> [Finite a]) -> [Finite a] -> [Finite a]
forall a b. (a -> b) -> a -> b
$ Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts Enumerate a
e where
    -- The first value is at index 0 and the last value is at index ~= crd - step
    -- This is "fair" if we consider using samplePart on the next part as well.
    -- An alternative would be to make the last index used |crd-1|.
    samplePart :: Index -> Finite a -> Finite a
    samplePart :: Integer -> Finite a -> Finite a
samplePart Integer
m f :: Finite a
f@(Finite Integer
crd Integer -> a
_) =
      let  step :: Ratio Integer
step  =  Integer
crd Integer -> Integer -> Ratio Integer
forall a. Integral a => a -> a -> Ratio a
% Integer
m
      in if Integer
crd Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
m
           then Finite a
f
           else Finite :: forall a. Integer -> (Integer -> a) -> Finite a
Finite{fCard :: Integer
fCard = Integer
m, fIndex :: Integer -> a
fIndex = \Integer
i -> Finite a -> Integer -> a
forall a. Finite a -> Integer -> a
fIndex Finite a
f (Ratio Integer -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
floor (Integer -> Ratio Integer
forall a. Real a => a -> Ratio Integer
toRational Integer
i Ratio Integer -> Ratio Integer -> Ratio Integer
forall a. Num a => a -> a -> a
* Ratio Integer
step))}

-- | Remove all sizes exept those in the given inclusive (low,high) range 
sizeRange :: Enumerate a -> (Int, Int) -> Enumerate a
sizeRange :: Enumerate a -> (Int, Int) -> Enumerate a
sizeRange Enumerate a
e (Int
lo, Int
hi) = [Finite a] -> Enumerate a
forall a. [Finite a] -> Enumerate a
fromParts ([Finite a] -> Enumerate a) -> [Finite a] -> Enumerate a
forall a b. (a -> b) -> a -> b
$ Int -> [Finite a] -> [Finite a]
forall a. Int -> [a] -> [a]
take (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
lo) ([Finite a] -> [Finite a]) -> [Finite a] -> [Finite a]
forall a b. (a -> b) -> a -> b
$ Int -> [Finite a] -> [Finite a]
forall a. Int -> [a] -> [a]
drop Int
lo ([Finite a] -> [Finite a]) -> [Finite a] -> [Finite a]
forall a b. (a -> b) -> a -> b
$ Enumerate a -> [Finite a]
forall a. Enumerate a -> [Finite a]
parts Enumerate a
e