{-#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 :: forall a. Enumerable a => Int -> [a]
values = forall a. Values a -> Int -> [a]
runValues 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' :: forall a. Enumerable a => Int -> [[a]]
values' Int
i = let f :: Int -> [a]
f = forall a. Values a -> Int -> [a]
runValues 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 :: forall a. Enumerable a => [[a]]
allValues = forall a. Values a -> MaxSize a -> [[a]]
aux forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global forall (f :: * -> *) a. (Typeable f, Sized f, Enumerable a) => f a
global where
  aux :: Values a -> MaxSize a -> [[a]]
  aux :: forall a. Values a -> MaxSize a -> [[a]]
aux (Values Int -> [a]
f) (MaxSize [()]
m) = forall a b. (a -> b) -> [a] -> [b]
map Int -> [a]
f (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a b. a -> b -> a
const [Int
0..] [()]
m)



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

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

instance Applicative Values where
  pure :: forall a. a -> Values a
pure a
x     = forall a. (Int -> [a]) -> Values a
Values forall a b. (a -> b) -> a -> b
$ \Int
i -> if Int
i forall a. Eq a => a -> a -> Bool
== Int
0 then [a
x] else []
  Values (a -> b)
fs <*> :: forall a b. Values (a -> b) -> Values a -> Values b
<*> Values a
xs  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. (a -> b) -> a -> b
($)) (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 :: forall a. Values a
empty     = forall a. (Int -> [a]) -> Values a
Values forall a b. (a -> b) -> a -> b
$ \Int
_ -> []
  Values a
xs <|> :: forall a. Values a -> Values a -> Values a
<|> Values a
ys = forall a. (Int -> [a]) -> Values a
Values forall a b. (a -> b) -> a -> b
$ \Int
i -> forall a. Values a -> Int -> [a]
runValues Values a
xs Int
i forall a. [a] -> [a] -> [a]
++ forall a. Values a -> Int -> [a]
runValues Values a
ys Int
i

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

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




-- Useful for detecting if an enumeration is finite.
data MaxSize a = MaxSize {forall a. MaxSize a -> [()]
runMaxSize :: [()]} deriving (Int -> MaxSize a -> ShowS
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 :: forall a b. (a -> b) -> MaxSize a -> MaxSize b
fmap a -> b
_ = forall a. [()] -> MaxSize a
MaxSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MaxSize a -> [()]
runMaxSize

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

instance Alternative MaxSize where
  empty :: forall a. MaxSize a
empty = forall a. [()] -> MaxSize a
MaxSize []
  MaxSize a
a <|> :: forall a. MaxSize a -> MaxSize a -> MaxSize a
<|> MaxSize a
b = forall a. [()] -> MaxSize a
MaxSize (forall a. MaxSize a -> [()]
runMaxSize MaxSize a
a [()] -> [()] -> [()]
`zipL` 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 :: forall a. MaxSize a -> MaxSize a
pay = forall a. [()] -> MaxSize a
MaxSize forall b c a. (b -> c) -> (a -> b) -> a -> c
. (()forall a. a -> [a] -> [a]
:) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. MaxSize a -> [()]
runMaxSize


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