{-#LANGUAGE DeriveDataTypeable#-}
module Control.Enumerable.Values
  ( values
  , values'
  , allValues
  , Values (..)
  )  where

import Control.Enumerable

-- | Constructs all values of a given size.
values :: Enumerable a => Int -> [a]
values :: Int -> [a]
values = Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global

-- | Constructs all values up to a given size.
values' :: Enumerable a => Int -> [[a]]
values' :: Int -> [[a]]
values' Int
i = let f :: Int -> [a]
f = Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global in [Int -> [a]
f Int
x|Int
x <- [Int
0..Int
i]]

allValues :: Enumerable a => [[a]]
allValues :: [[a]]
allValues = Values a -> MaxSize a -> [[a]]
forall a. Values a -> MaxSize a -> [[a]]
aux Values a
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global MaxSize a
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global where
  aux :: Values a -> MaxSize a -> [[a]]
  aux :: Values a -> MaxSize a -> [[a]]
aux (Values Int -> [a]
f) (MaxSize [()]
m) = (Int -> [a]) -> [Int] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map Int -> [a]
f ((Int -> () -> Int) -> [Int] -> [()] -> [Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> () -> Int
forall a b. a -> b -> a
const [Int
0..] [()]
m)



newtype Values a = Values {Values a -> Int -> [a]
runValues :: Int -> [a]} deriving Typeable

instance Functor Values where
  fmap :: (a -> b) -> Values a -> Values b
fmap a -> b
f = (Int -> [b]) -> Values b
forall a. (Int -> [a]) -> Values a
Values ((Int -> [b]) -> Values b)
-> (Values a -> Int -> [b]) -> Values a -> Values b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([a] -> [b]) -> (Int -> [a]) -> Int -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) ((Int -> [a]) -> Int -> [b])
-> (Values a -> Int -> [a]) -> Values a -> Int -> [b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues

instance Applicative Values where
  pure :: a -> Values a
pure a
x     = (Int -> [a]) -> Values a
forall a. (Int -> [a]) -> Values a
Values ((Int -> [a]) -> Values a) -> (Int -> [a]) -> Values a
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [a
x] else []
  Values (a -> b)
fs <*> :: Values (a -> b) -> Values a -> Values b
<*> Values a
xs  = ((a -> b, a) -> b) -> Values (a -> b, a) -> Values b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((a -> b) -> a -> b) -> (a -> b, a) -> b
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
($)) (Values (a -> b) -> Values a -> Values (a -> b, a)
forall (f :: * -> *) a b. Sized f => f a -> f b -> f (a, b)
pair Values (a -> b)
fs Values a
xs)

instance Alternative Values where
  empty :: Values a
empty     = (Int -> [a]) -> Values a
forall a. (Int -> [a]) -> Values a
Values ((Int -> [a]) -> Values a) -> (Int -> [a]) -> Values a
forall a b. (a -> b) -> a -> b
$ \Int
_ -> []
  Values a
xs <|> :: Values a -> Values a -> Values a
<|> Values a
ys = (Int -> [a]) -> Values a
forall a. (Int -> [a]) -> Values a
Values ((Int -> [a]) -> Values a) -> (Int -> [a]) -> Values a
forall a b. (a -> b) -> a -> b
$ \Int
i -> Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
xs Int
i [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
ys Int
i

instance Sized Values where
  pay :: Values a -> Values a
pay Values a
xs       = (Int -> [a]) -> Values a
forall a. (Int -> [a]) -> Values a
Values ((Int -> [a]) -> Values a) -> (Int -> [a]) -> Values a
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
xs (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) else []
  pair :: Values a -> Values b -> Values (a, b)
pair Values a
xs Values b
ys   = (Int -> [(a, b)]) -> Values (a, b)
forall a. (Int -> [a]) -> Values a
Values ((Int -> [(a, b)]) -> Values (a, b))
-> (Int -> [(a, b)]) -> Values (a, b)
forall a b. (a -> b) -> a -> b
$ \Int
i -> [(a
x,b
y)|Int
n <- [Int
0..Int
i], a
x <- Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues Values a
xs Int
n, b
y <- Values b -> Int -> [b]
forall a. Values a -> Int -> [a]
runValues Values b
ys (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
n)]

  fin :: Integer -> Values Integer
fin Integer
n        = (Int -> [Integer]) -> Values Integer
forall a. (Int -> [a]) -> Values a
Values ((Int -> [Integer]) -> Values Integer)
-> (Int -> [Integer]) -> Values Integer
forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then [Integer
0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1] else []
  aconcat :: [Values a] -> Values a
aconcat []   = Values a
forall (f :: * -> *) a. Alternative f => f a
empty
  aconcat [Values a
x]  = Values a
x
  aconcat [Values a]
xss  = (Int -> [a]) -> Values a
forall a. (Int -> [a]) -> Values a
Values ((Int -> [a]) -> Values a) -> (Int -> [a]) -> Values a
forall a b. (a -> b) -> a -> b
$ \Int
i -> (Values a -> [a]) -> [Values a] -> [a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (((Int -> [a]) -> Int -> [a]
forall a b. (a -> b) -> a -> b
$ Int
i) ((Int -> [a]) -> [a])
-> (Values a -> Int -> [a]) -> Values a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Values a -> Int -> [a]
forall a. Values a -> Int -> [a]
runValues) [Values a]
xss




-- Useful for detecting if an enumeration is finite.
data MaxSize a = MaxSize {MaxSize a -> [()]
runMaxSize :: [()]} deriving (Int -> MaxSize a -> ShowS
[MaxSize a] -> ShowS
MaxSize a -> String
(Int -> MaxSize a -> ShowS)
-> (MaxSize a -> String)
-> ([MaxSize a] -> ShowS)
-> Show (MaxSize a)
forall a. Int -> MaxSize a -> ShowS
forall a. [MaxSize a] -> ShowS
forall a. MaxSize a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MaxSize a] -> ShowS
$cshowList :: forall a. [MaxSize a] -> ShowS
show :: MaxSize a -> String
$cshow :: forall a. MaxSize a -> String
showsPrec :: Int -> MaxSize a -> ShowS
$cshowsPrec :: forall a. Int -> MaxSize a -> ShowS
Show, Typeable)
instance Functor MaxSize where fmap :: (a -> b) -> MaxSize a -> MaxSize b
fmap a -> b
_ = [()] -> MaxSize b
forall a. [()] -> MaxSize a
MaxSize ([()] -> MaxSize b)
-> (MaxSize a -> [()]) -> MaxSize a -> MaxSize b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxSize a -> [()]
forall a. MaxSize a -> [()]
runMaxSize

instance Applicative MaxSize where
  pure :: a -> MaxSize a
pure a
_ = [()] -> MaxSize a
forall a. [()] -> MaxSize a
MaxSize [()]
  MaxSize [] <*> :: MaxSize (a -> b) -> MaxSize a -> MaxSize b
<*> MaxSize a
_  = MaxSize b
forall (f :: * -> *) a. Alternative f => f a
empty
  MaxSize (a -> b)
_ <*> MaxSize []  = MaxSize b
forall (f :: * -> *) a. Alternative f => f a
empty
  MaxSize (a -> b)
f <*> MaxSize a
x = [()] -> MaxSize b
forall a. [()] -> MaxSize a
MaxSize ([()] -> MaxSize b) -> [()] -> MaxSize b
forall a b. (a -> b) -> a -> b
$ [()] -> [()]
forall a. [a] -> [a]
tail (MaxSize (a -> b) -> [()]
forall a. MaxSize a -> [()]
runMaxSize MaxSize (a -> b)
f [()] -> [()] -> [()]
forall a. [a] -> [a] -> [a]
++ MaxSize a -> [()]
forall a. MaxSize a -> [()]
runMaxSize MaxSize a
x)

instance Alternative MaxSize where
  empty :: MaxSize a
empty = [()] -> MaxSize a
forall a. [()] -> MaxSize a
MaxSize []
  MaxSize a
a <|> :: MaxSize a -> MaxSize a -> MaxSize a
<|> MaxSize a
b = [()] -> MaxSize a
forall a. [()] -> MaxSize a
MaxSize (MaxSize a -> [()]
forall a. MaxSize a -> [()]
runMaxSize MaxSize a
a [()] -> [()] -> [()]
`zipL` MaxSize a -> [()]
forall a. MaxSize a -> [()]
runMaxSize MaxSize a
b) where
    zipL :: [()] -> [()] -> [()]
zipL [] [()]
x = [()]
x
    zipL [()]
x [] = [()]
x
    zipL (()
_:[()]
xs) (()
_:[()]
ys) = () () -> [()] -> [()]
forall a. a -> [a] -> [a]
: [()]
xs [()] -> [()] -> [()]
`zipL` [()]
ys


instance Sized MaxSize where
  pay :: MaxSize a -> MaxSize a
pay = [()] -> MaxSize a
forall a. [()] -> MaxSize a
MaxSize ([()] -> MaxSize a)
-> (MaxSize a -> [()]) -> MaxSize a -> MaxSize a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (()() -> [()] -> [()]
forall a. a -> [a] -> [a]
:) ([()] -> [()]) -> (MaxSize a -> [()]) -> MaxSize a -> [()]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaxSize a -> [()]
forall a. MaxSize a -> [()]
runMaxSize


type TT = Bool --  [[[[[[[[[[Bool]]]]]]]]]]
tst1 :: Int -> [()]
tst1 Int
n = Int -> [()] -> [()]
forall a. Int -> [a] -> [a]
take Int
n ([()] -> [()]) -> [()] -> [()]
forall a b. (a -> b) -> a -> b
$ MaxSize Bool -> [()]
forall a. MaxSize a -> [()]
runMaxSize (MaxSize Bool
forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
local :: MaxSize TT)