{-|

This module provides the 'Sized' class. Instances of this class are typically collection data types for infinite sets of values with a finite number of values of any given size.

A simple example is "Control.Enumerable.Count" that just counts the number of values of each size. "Control.Enumerable.Values" provides all values of a given size.
<https://hackage.haskell.org/package/testing-feat FEAT> provides any value in the set much more efficiently.

-}
module Control.Sized (module Control.Applicative, Sized(..), kbits) where
import Control.Applicative

-- | A sized functor is an applicative functor extended with a notion of cost/size of contained values. This is useful for any type of bounded recursion over infinite sets, most notably for various kind of enumerations.
--
-- The intention is that every sized functor definition models a (usually) infinite set (technically a bag) with a finite number of values of any given size. As long as every cyclic (recursive) definition has at least one application of pay, this invariant is guaranteed.
--
-- The module "Control.Enumerable" provides sized functor definitions for a lot of data types, such that the size of a value is the number of constructor applications it contains. It also allows deriving these functors for any user defined data type (using Template Haskell).
class Alternative f => Sized f where
  -- | Increases the cost/size of all values in the given set.
  pay :: f a -> f a

  -- | Default: @pair a b = (,) <$> a <*> b@.
  pair :: f a -> f b -> f (a,b)
  pair f a
a f b
b = (,) (a -> b -> (a, b)) -> f a -> f (b -> (a, b))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
a f (b -> (a, b)) -> f b -> f (a, b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
b

  -- | Default: @aconcat = foldr (\<|>) empty@
  aconcat :: [f a] -> f a
  aconcat []   = f a
forall (f :: * -> *) a. Alternative f => f a
empty
  aconcat [f a]
xs   = (f a -> f a -> f a) -> [f a] -> f a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) [f a]
xs

  {- | Finite numeric types. @fin n@ contains all non-negative numbers below n. This definition is flat, all integers have the same size.
  Implementing this function efficiently will have a great impact on applications that use a lot of bounded numeric types (e.g. Int).

  Default: aconcat (map pure [0..n-1]) -}
  fin :: Integer -> f Integer
  fin Integer
n = [f Integer] -> f Integer
forall (f :: * -> *) a. Sized f => [f a] -> f a
aconcat ((Integer -> f Integer) -> [Integer] -> [f Integer]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Integer
0..Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1])

  {- |Same as 'fin' but the size of values may differ.
  By default, the size of an integer is the number of significant bits in its binary representation. In other words, 0 has size zero, the values for size k>0 in @finBits n@ are in the interval
  @(2^(k-1),min (2^k-1) n)@. -}
  finSized :: Integer -> f Integer
  finSized = Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
stdFinBits

  -- | Non-negative integers. By default, the size of an integer is the number of digits in its binary representation.
  naturals :: f Integer
  naturals = f Integer
forall (f :: * -> *). Sized f => f Integer
stdNaturals


stdNaturals :: Sized f => f Integer
stdNaturals :: f Integer
stdNaturals = Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0 f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> f Integer
forall (f :: * -> *) t. (Sized f, Integral t) => t -> f Integer
go Integer
0 where
  go :: t -> f Integer
go t
n = f Integer -> f Integer
forall (f :: * -> *) a. Sized f => f a -> f a
pay (f Integer -> f Integer) -> f Integer -> f Integer
forall a b. (a -> b) -> a -> b
$ ((Integer
2Integer -> t -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^t
n)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
fin (Integer
2Integer -> t -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^t
n) f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (t -> f Integer
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
+t
1))

stdNaturals' :: Sized f => f Integer
stdNaturals' :: f Integer
stdNaturals' = Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0 f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
go Integer
1 where
  go :: Integer -> f Integer
go Integer
n   = f Integer -> f Integer
forall (f :: * -> *) a. Sized f => f a -> f a
pay (f Integer -> f Integer) -> f Integer -> f Integer
forall a b. (a -> b) -> a -> b
$ (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
fin Integer
n f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> f Integer
go (Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n)


stdFinBits :: Sized f => Integer -> f Integer
stdFinBits :: Integer -> f Integer
stdFinBits Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0  = f Integer
forall (f :: * -> *) a. Alternative f => f a
empty
stdFinBits Integer
i           = Integer -> f Integer
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0 f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
go Integer
1 where
  go :: Integer -> f Integer
go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
lim   = f Integer -> f Integer
forall (f :: * -> *) a. Sized f => f a -> f a
pay (f Integer -> f Integer) -> f Integer -> f Integer
forall a b. (a -> b) -> a -> b
$ (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
fin Integer
n f Integer -> f Integer -> f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> f Integer
go (Integer
2Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
*Integer
n)
  go Integer
n | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
i     = f Integer
forall (f :: * -> *) a. Alternative f => f a
empty
  go Integer
n              = f Integer -> f Integer
forall (f :: * -> *) a. Sized f => f a -> f a
pay (f Integer -> f Integer) -> f Integer -> f Integer
forall a b. (a -> b) -> a -> b
$ (Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
+) (Integer -> Integer) -> f Integer -> f Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
fin (Integer
iInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
n)
  lim :: Integer
lim = Integer
i Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2

-- Non-negative integers of a given maximal number of bits.
kbits :: Sized f => Int -> f Integer
kbits :: Int -> f Integer
kbits Int
k = Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
finSized (Integer
2Integer -> Int -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Int
k)




-- integers :: Sized f => (Int -> (Integer,Integer)) -> f Integer
-- integers =

-- ints :: Sized f => Int -> (Int -> (Integer,Integer)) -> f Integer