{-#LANGUAGE TemplateHaskell#-}

{-|
This module provides the 'Enumerable' class, which has a simple purpose: Provide any enumeration for any instance type. The prerequisite is that the enumeration data type is a sized functor (see "Control.Sized") with the enumerated type as the type parameter. The general idea is that the size of a value is the number of constructor applications it contains.

Because Sized functors often rely of memoization, sharing is important. Since class dictionaries are not always shared, a mechanism is added that guarantees optimal sharing (it never creates two separate instance members for the same type). This is why the type of 'enumerate' is @Shared f a@ instead of simply @f a@. The technicalities of this memoization are not important, but it means there are two modes for accessing an enumeration: 'local' and 'global'. The former means sharing is guaranteed within this value, but subsequent calls to local may recreate dictionaries. The latter guarantees optimal sharing even between calls. It also means the enumeration will never be garbage collected, so use with care in programs that run for extended periods of time and contains many (especially non-regular) types.

Once a type has an instance, it can be enumerated in several ways (by instantiating 'global' to different types). For instance @global :: Count [Maybe Bool]@ would only count the number of lists of Maybe Bool of each size (using "Control.Enumerable.Count"). @global :: Values [Maybe Bool] would give the actual values for all sizes as lists. See <https://hackage.haskell.org/package/testing-feat FEAT> for a more elaborate enumeration type that allows access to any value in the enumeration (given an index) in polynomial time, uniform selection from a given size etc.

Instances can be constructed in three ways:

1: Manually by passing 'datatype' a list where each element is an application of the constructor functions 'c0', 'c1' etc, so a data type like Maybe would have @enumerate = datatype [c0 Nothing, c1 Just]@. This assumes all field types of all constructors are enumerable (recursive constructors work fine). The functions passed to @cX@ do not have to be constructors, but should be injective functions (if they are not injective the enumeration will contain duplicates). So "smart constructors" can be used, for instance the @Rational@ datatype is defined by an injection from the natural numbers.

2: Automatically with Template Haskell ('deriveEnumerable'). A top level declaration like @deriveEnumerable ''Maybe@ would derive an instance for the @Maybe@ data type.

3: Manually using the operations of a sized functor (see "Control.Sized") to build a @Shareable f a@ value, then apply 'share' to it. To use other instances of 'Enumerable' use 'access'.

-}
module Control.Enumerable
  ( Enumerable(..)
  -- * Class based construction
  , datatype, c0, c1, c2, c3, c4, c5, c6, c7
  -- * Access
  , global, local

  -- * Automatic derivation
  , deriveEnumerable
  , dAll, dExcluding, dExcept, ConstructorDeriv, deriveEnumerable'

  -- * Non-class construction
  , access, share, Shared, Shareable, Typeable, module Control.Sized

  -- * Enumerating functions
  , function, CoEnumerable(..)

  -- * Other stuff (required for instances)
  , Infinite
  )where
import Control.Sized
import Data.ClassSharing

-- For instances
import Data.Modifiers
import Data.Bits
import Data.Word
import Data.Int
import Data.Ratio
import Control.Enumerable.Derive hiding (global)

instance (Typeable f, Sized f) => Sized (Shareable f) where
  pay :: Shareable f a -> Shareable f a
pay         = (Ref -> f a) -> Shareable f a
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable ((Ref -> f a) -> Shareable f a)
-> (Shareable f a -> Ref -> f a) -> Shareable f a -> Shareable f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (f a -> f a) -> (Ref -> f a) -> Ref -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f a -> f a
forall (f :: * -> *) a. Sized f => f a -> f a
pay ((Ref -> f a) -> Ref -> f a)
-> (Shareable f a -> Ref -> f a) -> Shareable f a -> Ref -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shareable f a -> Ref -> f a
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run
  fin :: Integer -> Shareable f Integer
fin         = (Ref -> f Integer) -> Shareable f Integer
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable ((Ref -> f Integer) -> Shareable f Integer)
-> (Integer -> Ref -> f Integer) -> Integer -> Shareable f Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Integer -> Ref -> f Integer
forall a b. a -> b -> a
const (f Integer -> Ref -> f Integer)
-> (Integer -> f Integer) -> Integer -> Ref -> f Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
fin
  pair :: Shareable f a -> Shareable f b -> Shareable f (a, b)
pair Shareable f a
x Shareable f b
y    = (Ref -> f (a, b)) -> Shareable f (a, b)
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable ((Ref -> f (a, b)) -> Shareable f (a, b))
-> (Ref -> f (a, b)) -> Shareable f (a, b)
forall a b. (a -> b) -> a -> b
$ \Ref
r -> f a -> f b -> f (a, b)
forall (f :: * -> *) a b. Sized f => f a -> f b -> f (a, b)
pair (Shareable f a -> Ref -> f a
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f a
x Ref
r) (Shareable f b -> Ref -> f b
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f b
y Ref
r)
  aconcat :: [Shareable f a] -> Shareable f a
aconcat [Shareable f a]
xs  = (Ref -> f a) -> Shareable f a
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable ((Ref -> f a) -> Shareable f a) -> (Ref -> f a) -> Shareable f a
forall a b. (a -> b) -> a -> b
$ \Ref
r -> [f a] -> f a
forall (f :: * -> *) a. Sized f => [f a] -> f a
aconcat ((Shareable f a -> f a) -> [Shareable f a] -> [f a]
forall a b. (a -> b) -> [a] -> [b]
map (Shareable f a -> Ref -> f a
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
`run` Ref
r) [Shareable f a]
xs) 
  finSized :: Integer -> Shareable f Integer
finSized    = (Ref -> f Integer) -> Shareable f Integer
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable ((Ref -> f Integer) -> Shareable f Integer)
-> (Integer -> Ref -> f Integer) -> Integer -> Shareable f Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f Integer -> Ref -> f Integer
forall a b. a -> b -> a
const (f Integer -> Ref -> f Integer)
-> (Integer -> f Integer) -> Integer -> Ref -> f Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
finSized
  naturals :: Shareable f Integer
naturals    = (Ref -> f Integer) -> Shareable f Integer
forall (f :: * -> *) a. (Ref -> f a) -> Shareable f a
Shareable (f Integer -> Ref -> f Integer
forall a b. a -> b -> a
const f Integer
forall (f :: * -> *). Sized f => f Integer
naturals)

class Typeable a => Enumerable a where
  enumerate :: (Typeable f, Sized f) => Shared f a


-- | Used instead of enumerate when manually building instances.
access :: (Enumerable a, Sized f, Typeable f) => Shareable f a
access :: Shareable f a
access = Shared f a -> Shareable f a
forall (f :: * -> *) a. Shared f a -> Shareable f a
unsafeAccess Shared f a
forall a (f :: * -> *).
(Enumerable a, Typeable f, Sized f) =>
Shared f a
enumerate

-- | Guarantees local sharing. All enumerations are shared inside each invokation of local, but may not be shared between them.
{-#INLINE local#-}
local :: (Typeable f, Sized f, Enumerable a) => f a
local :: f a
local = Shareable f a -> Ref -> f a
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f a
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access (() -> Ref
unsafeNewRef ())

{-#NOINLINE gref#-}
gref :: Ref
gref :: Ref
gref = () -> Ref
unsafeNewRef ()

-- | This is the primary way to access enumerations for usage. Guarantees global sharing of enumerations of the same type. Note that this means the enumerations are never garbage collected.
global :: (Typeable f, Sized f, Enumerable a) => f a
global :: f a
global = Shareable f a -> Ref -> f a
forall (f :: * -> *) a. Shareable f a -> Ref -> f a
run Shareable f a
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access Ref
gref

-- | Builds an enumeration of a data type from a list of constructors (see c0-c7)
datatype :: (Typeable a, Sized f, Typeable f) => [Shareable f a] -> Shared f a
datatype :: [Shareable f a] -> Shared f a
datatype = Shareable f a -> Shared f a
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f a -> Shared f a)
-> ([Shareable f a] -> Shareable f a)
-> [Shareable f a]
-> Shared f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Shareable f a -> Shareable f a
forall (f :: * -> *) a. Sized f => f a -> f a
pay (Shareable f a -> Shareable f a)
-> ([Shareable f a] -> Shareable f a)
-> [Shareable f a]
-> Shareable f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Shareable f a] -> Shareable f a
forall (f :: * -> *) a. Sized f => [f a] -> f a
aconcat


-- | Takes a constructor with arity 0 (a pure value)
c0 :: Sized f => a -> Shareable f a
c0 :: a -> Shareable f a
c0 = a -> Shareable f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Takes a constructor of arity 1
c1 :: (Enumerable a, Sized f, Typeable f) => (a -> x) -> Shareable f x
c1 :: (a -> x) -> Shareable f x
c1 a -> x
f = (a -> x) -> Shareable f a -> Shareable f x
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> x
f Shareable f a
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access

c2 :: (Enumerable a, Enumerable b, Sized f, Typeable f) => (a -> b -> x) -> Shareable f x
c2 :: (a -> b -> x) -> Shareable f x
c2 a -> b -> x
f = ((a, b) -> x) -> Shareable f x
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 ((a -> b -> x) -> (a, b) -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> x
f)

c3 :: (Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) => (a -> b -> c -> x) -> Shareable f x
c3 :: (a -> b -> c -> x) -> Shareable f x
c3 a -> b -> c -> x
f = ((a, b) -> c -> x) -> Shareable f x
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 ((a -> b -> c -> x) -> (a, b) -> c -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> x
f)

c4 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f, Typeable f) => (a -> b -> c -> d -> x) -> Shareable f x
c4 :: (a -> b -> c -> d -> x) -> Shareable f x
c4 a -> b -> c -> d -> x
f = ((a, b) -> c -> d -> x) -> Shareable f x
forall a b c (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Sized f, Typeable f) =>
(a -> b -> c -> x) -> Shareable f x
c3 ((a -> b -> c -> d -> x) -> (a, b) -> c -> d -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> x
f)

c5 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Sized f, Typeable f) => (a -> b -> c -> d -> e -> x) -> Shareable f x
c5 :: (a -> b -> c -> d -> e -> x) -> Shareable f x
c5 a -> b -> c -> d -> e -> x
f = ((a, b) -> c -> d -> e -> x) -> Shareable f x
forall a b c d (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d, Sized f,
 Typeable f) =>
(a -> b -> c -> d -> x) -> Shareable f x
c4 ((a -> b -> c -> d -> e -> x) -> (a, b) -> c -> d -> e -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> x
f)

c6 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 :: (a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 a -> b -> c -> d -> e -> g -> x
f = ((a, b) -> c -> d -> e -> g -> x) -> Shareable f x
forall a b c d e (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
 Enumerable e, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> x) -> Shareable f x
c5 ((a -> b -> c -> d -> e -> g -> x)
-> (a, b) -> c -> d -> e -> g -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> g -> x
f)

c7 :: (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable g, Enumerable h, Sized f, Typeable f) => (a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x
c7 :: (a -> b -> c -> d -> e -> g -> h -> x) -> Shareable f x
c7 a -> b -> c -> d -> e -> g -> h -> x
f = ((a, b) -> c -> d -> e -> g -> h -> x) -> Shareable f x
forall a b c d e g (f :: * -> *) x.
(Enumerable a, Enumerable b, Enumerable c, Enumerable d,
 Enumerable e, Enumerable g, Sized f, Typeable f) =>
(a -> b -> c -> d -> e -> g -> x) -> Shareable f x
c6 ((a -> b -> c -> d -> e -> g -> h -> x)
-> (a, b) -> c -> d -> e -> g -> h -> x
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry a -> b -> c -> d -> e -> g -> h -> x
f)

-- More than seven constructor components? Uncurry your constructor!


-- | The unit constructor is free
instance Enumerable () where
  enumerate :: Shared f ()
enumerate = Shareable f () -> Shared f ()
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (() -> Shareable f ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- All tuple constructors are free
instance (Enumerable a, Enumerable b) => Enumerable (a,b) where
  enumerate :: Shared f (a, b)
enumerate = Shareable f (a, b) -> Shared f (a, b)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f (a, b) -> Shared f (a, b))
-> Shareable f (a, b) -> Shared f (a, b)
forall a b. (a -> b) -> a -> b
$ Shareable f a -> Shareable f b -> Shareable f (a, b)
forall (f :: * -> *) a b. Sized f => f a -> f b -> f (a, b)
pair Shareable f a
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access Shareable f b
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access -- Pairs are free

instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a,b,c) where
  enumerate :: Shared f (a, b, c)
enumerate = Shareable f (a, b, c) -> Shared f (a, b, c)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f (a, b, c) -> Shared f (a, b, c))
-> Shareable f (a, b, c) -> Shared f (a, b, c)
forall a b. (a -> b) -> a -> b
$ ((a, (b, c)) -> (a, b, c)) -> Shareable f (a, b, c)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (((a, (b, c)) -> (a, b, c)) -> Shareable f (a, b, c))
-> ((a, (b, c)) -> (a, b, c)) -> Shareable f (a, b, c)
forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,c
c)) -> (a
a,b
b,c
c)

instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d)
             => Enumerable (a,b,c,d) where
  enumerate :: Shared f (a, b, c, d)
enumerate = Shareable f (a, b, c, d) -> Shared f (a, b, c, d)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f (a, b, c, d) -> Shared f (a, b, c, d))
-> Shareable f (a, b, c, d) -> Shared f (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ ((a, (b, (c, d))) -> (a, b, c, d)) -> Shareable f (a, b, c, d)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (((a, (b, (c, d))) -> (a, b, c, d)) -> Shareable f (a, b, c, d))
-> ((a, (b, (c, d))) -> (a, b, c, d)) -> Shareable f (a, b, c, d)
forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,(c
c,d
d))) -> (a
a,b
b,c
c,d
d)

instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e)
             => Enumerable (a,b,c,d,e) where
  enumerate :: Shared f (a, b, c, d, e)
enumerate = Shareable f (a, b, c, d, e) -> Shared f (a, b, c, d, e)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f (a, b, c, d, e) -> Shared f (a, b, c, d, e))
-> Shareable f (a, b, c, d, e) -> Shared f (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ ((a, (b, (c, (d, e)))) -> (a, b, c, d, e))
-> Shareable f (a, b, c, d, e)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (((a, (b, (c, (d, e)))) -> (a, b, c, d, e))
 -> Shareable f (a, b, c, d, e))
-> ((a, (b, (c, (d, e)))) -> (a, b, c, d, e))
-> Shareable f (a, b, c, d, e)
forall a b. (a -> b) -> a -> b
$ \(a
a,(b
b,(c
c,(d
d,e
e)))) -> (a
a,b
b,c
c,d
d,e
e)


instance Enumerable Bool where
  enumerate :: Shared f Bool
enumerate = [Shareable f Bool] -> Shared f Bool
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [Bool -> Shareable f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False, Bool -> Shareable f Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True]

instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where
  enumerate :: Shared f (Either a b)
enumerate = [Shareable f (Either a b)] -> Shared f (Either a b)
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [(a -> Either a b) -> Shareable f (Either a b)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 a -> Either a b
forall a b. a -> Either a b
Left, (b -> Either a b) -> Shareable f (Either a b)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 b -> Either a b
forall a b. b -> Either a b
Right]

instance Enumerable a => Enumerable [a] where
  enumerate :: Shared f [a]
enumerate = [Shareable f [a]] -> Shared f [a]
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [[a] -> Shareable f [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [], (a -> [a] -> [a]) -> Shareable f [a]
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 (:)]

instance Enumerable a => Enumerable (Maybe a) where
  enumerate :: Shared f (Maybe a)
enumerate = [Shareable f (Maybe a)] -> Shared f (Maybe a)
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [Maybe a -> Shareable f (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing, (a -> Maybe a) -> Shareable f (Maybe a)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 a -> Maybe a
forall a. a -> Maybe a
Just]

instance Enumerable Ordering where
  enumerate :: Shared f Ordering
enumerate = [Shareable f Ordering] -> Shared f Ordering
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [Ordering -> Shareable f Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
LT, Ordering -> Shareable f Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
EQ, Ordering -> Shareable f Ordering
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ordering
GT]

instance Enumerable Integer where
  enumerate :: Shared f Integer
enumerate = Shareable f Integer -> Shared f Integer
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f Integer -> Shared f Integer)
-> Shareable f Integer -> Shared f Integer
forall a b. (a -> b) -> a -> b
$ (Nat Integer -> Integer) -> Shareable f Integer
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 Nat Integer -> Integer
forall a. Nat a -> a
nat Shareable f Integer -> Shareable f Integer -> Shareable f Integer
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Nat Integer -> Integer) -> Shareable f Integer
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 (\(Nat Integer
n) -> -Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)

instance Enumerable Word where enumerate :: Shared f Word
enumerate = Shareable f Word -> Shared f Word
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Word
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word

instance Enumerable Word8 where enumerate :: Shared f Word8
enumerate = Shareable f Word8 -> Shared f Word8
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Word8
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word -- enumerate = share (fromInteger <$> fin 256) -- Flat definition

instance Enumerable Word16 where enumerate :: Shared f Word16
enumerate = Shareable f Word16 -> Shared f Word16
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Word16
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word

instance Enumerable Word32 where enumerate :: Shared f Word32
enumerate = Shareable f Word32 -> Shared f Word32
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Word32
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word

instance Enumerable Word64 where enumerate :: Shared f Word64
enumerate = Shareable f Word64 -> Shared f Word64
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Word64
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
word

instance Enumerable Int where enumerate :: Shared f Int
enumerate = Shareable f Int -> Shared f Int
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Int
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int

instance Enumerable Int8 where enumerate :: Shared f Int8
enumerate = Shareable f Int8 -> Shared f Int8
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Int8
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int

instance Enumerable Int16 where enumerate :: Shared f Int16
enumerate = Shareable f Int16 -> Shared f Int16
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Int16
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int

instance Enumerable Int32 where enumerate :: Shared f Int32
enumerate = Shareable f Int32 -> Shared f Int32
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Int32
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int

instance Enumerable Int64 where enumerate :: Shared f Int64
enumerate = Shareable f Int64 -> Shared f Int64
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share Shareable f Int64
forall a (f :: * -> *). (FiniteBits a, Integral a, Sized f) => f a
int

-- | ASCII characters
instance Enumerable Char where
  enumerate :: Shared f Char
enumerate = Shareable f Char -> Shared f Char
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f Char -> Shared f Char)
-> Shareable f Char -> Shared f Char
forall a b. (a -> b) -> a -> b
$ (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Integer -> Int) -> Integer -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (Integer -> Char) -> Shareable f Integer -> Shareable f Char
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Shareable f Integer
forall (f :: * -> *). Sized f => Int -> f Integer
kbits Int
7
   -- Swap the printable characters to the start of the enumeration
   -- swapCharacters :: Word8 -> Char

-- | Not a proper injection
instance Enumerable Float where
  enumerate :: Shared f Float
enumerate = Shareable f Float -> Shared f Float
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f Float -> Shared f Float)
-> Shareable f Float -> Shared f Float
forall a b. (a -> b) -> a -> b
$ (Int8 -> Integer -> Float) -> Shareable f Float
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 ((Int8 -> Integer -> Float) -> Shareable f Float)
-> (Int8 -> Integer -> Float) -> Shareable f Float
forall a b. (a -> b) -> a -> b
$ \Int8
b Integer
a -> Integer -> Int -> Float
forall a. RealFloat a => Integer -> Int -> a
encodeFloat Integer
a (Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int8
b :: Int8))

-- | Not a proper injection
instance Enumerable Double where
  enumerate :: Shared f Double
enumerate = Shareable f Double -> Shared f Double
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f Double -> Shared f Double)
-> Shareable f Double -> Shared f Double
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Double
forall a. RealFloat a => Integer -> Int -> a
encodeFloat (Integer -> Int -> Double)
-> Shareable f Integer -> Shareable f (Int -> Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shareable f Integer
forall a (f :: * -> *).
(Enumerable a, Sized f, Typeable f) =>
Shareable f a
access Shareable f (Int -> Double)
-> Shareable f Int -> Shareable f Double
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Shareable f Int
e where
    e :: Shareable f Int
e = Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Shareable f Int -> Shareable f Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Int -> Shareable f Int
forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded (-Int
1) (-Int
lo)  Shareable f Int -> Shareable f Int -> Shareable f Int
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Int -> Shareable f Int
forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded Int
0 Int
hi
    (Int
lo,Int
hi) = Double -> (Int, Int)
forall a. RealFloat a => a -> (Int, Int)
floatRange (Double
0 :: Double)


-- | A class of infinite precision integral types. 'Integer' is the principal
-- class member.
class (Typeable a, Integral a) => Infinite a
instance Infinite Integer


instance Infinite a => Enumerable (Ratio a) where
  enumerate :: Shared f (Ratio a)
enumerate = Shareable f (Ratio a) -> Shared f (Ratio a)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share ((Nat Integer -> Ratio a) -> Shareable f (Ratio a)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 ((Nat Integer -> Ratio a) -> Shareable f (Ratio a))
-> (Nat Integer -> Ratio a) -> Shareable f (Ratio a)
forall a b. (a -> b) -> a -> b
$ Integer -> Ratio a
forall a. Integral a => Integer -> Ratio a
rat (Integer -> Ratio a)
-> (Nat Integer -> Integer) -> Nat Integer -> Ratio a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Nat Integer -> Integer
forall a. Nat a -> a
nat)

-- | Bijection into the rationals
rat :: Integral a => Integer -> Ratio a
rat :: Integer -> Ratio a
rat Integer
i | Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = [Char] -> Ratio a
forall a. HasCallStack => [Char] -> a
error [Char]
"Index out of bounds"
rat Integer
i = a -> a -> Integer -> Ratio a
forall a t. (Integral a, Integral t) => a -> a -> t -> Ratio a
go a
1 a
1 Integer
i where
  go :: a -> a -> t -> Ratio a
go a
a a
b t
0 = a
a a -> a -> Ratio a
forall a. Integral a => a -> a -> Ratio a
% a
b
  go a
a a
b t
i = let (t
i',t
m) = t
i t -> t -> (t, t)
forall a. Integral a => a -> a -> (a, a)
`divMod` t
2 in if t
m t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
1 then a -> a -> t -> Ratio a
go (a
aa -> a -> a
forall a. Num a => a -> a -> a
+a
b) a
b t
i' else a -> a -> t -> Ratio a
go a
a (a
a a -> a -> a
forall a. Num a => a -> a -> a
+a
b) t
i'


-- From Data.Modifiers:
instance Enumerable Unicode where
  enumerate :: Shared f Unicode
enumerate = [Shareable f Unicode] -> Shared f Unicode
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [(Char -> Unicode) -> Shareable f Char -> Shareable f Unicode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Unicode
Unicode (Shareable f Char -> Shareable f Unicode)
-> Shareable f Char -> Shareable f Unicode
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Shareable f Char
forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded
    (Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
minBound :: Char))
    (Char -> Int
forall a. Enum a => a -> Int
fromEnum (Char
forall a. Bounded a => a
maxBound :: Char))]

instance Enumerable Printable where
  enumerate :: Shared f Printable
enumerate = Shareable f Printable -> Shared f Printable
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (Shareable f Printable -> Shared f Printable)
-> Shareable f Printable -> Shared f Printable
forall a b. (a -> b) -> a -> b
$ (Char -> Printable) -> Shareable f Char -> Shareable f Printable
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Char -> Printable
Printable (Shareable f Char -> Shareable f Printable)
-> Shareable f Char -> Shareable f Printable
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Shareable f Char
forall (f :: * -> *) a. (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded Int
32 Int
126

enumerateBounded :: (Sized f, Enum a) => Int -> Int -> f a
enumerateBounded :: Int -> Int -> f a
enumerateBounded Int
lo Int
hi = Integer -> a
forall a. Enum a => Integer -> a
trans (Integer -> a) -> f Integer -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> f Integer
forall (f :: * -> *). Sized f => Integer -> f Integer
finSized (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo)) where
  trans :: Integer -> a
trans Integer
i = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
lo Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
i)



-- * modifiers:
-- Enumerable Printable
-- Enumerable Unicode
-- (Infinite a, Enumerable a) => Enumerable (NonZero a)
-- Infinite a => Enumerable (Nat a)
-- Enumerable a => Enumerable (NonEmpty a)

instance Infinite integer => Enumerable (Nat integer) where
  enumerate :: Shared f (Nat integer)
enumerate = Shareable f (Nat integer) -> Shared f (Nat integer)
forall a (f :: * -> *).
(Typeable a, Typeable f) =>
Shareable f a -> Shared f a
share (integer -> Nat integer
forall a. a -> Nat a
Nat (integer -> Nat integer)
-> (Integer -> integer) -> Integer -> Nat integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Nat integer)
-> Shareable f Integer -> Shareable f (Nat integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Shareable f Integer
forall (f :: * -> *). Sized f => f Integer
naturals)

instance Enumerable a => Enumerable (NonEmpty a) where
  enumerate :: Shared f (NonEmpty a)
enumerate = [Shareable f (NonEmpty a)] -> Shared f (NonEmpty a)
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [(a -> [a] -> NonEmpty a) -> Shareable f (NonEmpty a)
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 ((a -> [a] -> NonEmpty a) -> Shareable f (NonEmpty a))
-> (a -> [a] -> NonEmpty a) -> Shareable f (NonEmpty a)
forall a b. (a -> b) -> a -> b
$ a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
mkNonEmpty]


word :: (FiniteBits a, Integral a, Sized f) => f a
word :: f a
word = let e :: f a
e = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> f Integer -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Integer
forall (f :: * -> *). Sized f => Int -> f Integer
kbits (f a -> Int
forall a (f :: * -> *). FiniteBits a => f a -> Int
bitSize' f a
e) in f a
e

int :: (FiniteBits a, Integral a, Sized f) => f a
int :: f a
int = let e :: f a
e = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer -> a) -> f Integer -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
kbs f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (\Integer
n -> Integer -> a
forall a. Num a => Integer -> a
fromInteger (-Integer
nInteger -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1)) (Integer -> a) -> f Integer -> f a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f Integer
kbs
          kbs :: f Integer
kbs = 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
^(f a -> Int
forall a (f :: * -> *). FiniteBits a => f a -> Int
bitSize' f a
e Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
      in f a
e


bitSize' :: FiniteBits a => f a -> Int
bitSize' :: f a -> Int
bitSize' f a
f = a -> f a -> Int
forall a (f :: * -> *). FiniteBits a => a -> f a -> Int
hlp ([Char] -> a
forall a. HasCallStack => [Char] -> a
error [Char]
"Enumerable: This is not supposed to be inspected") f a
f where
  hlp :: FiniteBits a => a -> f a -> Int
  hlp :: a -> f a -> Int
hlp a
a f a
_ = a -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize a
a


-- | Work in progress
class Typeable a => CoEnumerable a where
  coEnumerate :: (Enumerable b,Sized f, Typeable f) => Shared f (a -> b)

-- | Builds a suitable definition for @coEnumerate@ given an pattern matching function for a data type (see source for examples).
function :: (Typeable a, Enumerable b, Sized f, Typeable f) => Shareable f (a -> b) -> Shared f (a -> b)
function :: Shareable f (a -> b) -> Shared f (a -> b)
function Shareable f (a -> b)
f = [Shareable f (a -> b)] -> Shared f (a -> b)
forall a (f :: * -> *).
(Typeable a, Sized f, Typeable f) =>
[Shareable f a] -> Shared f a
datatype [ (b -> a -> b) -> Shareable f (a -> b)
forall a (f :: * -> *) x.
(Enumerable a, Sized f, Typeable f) =>
(a -> x) -> Shareable f x
c1 b -> a -> b
forall a b. a -> b -> a
const, Shareable f (a -> b)
f]


instance (CoEnumerable a, Enumerable b) => Enumerable (a -> b) where
  enumerate :: Shared f (a -> b)
enumerate = Shared f (a -> b)
forall a b (f :: * -> *).
(CoEnumerable a, Enumerable b, Sized f, Typeable f) =>
Shared f (a -> b)
coEnumerate

instance CoEnumerable Bool where
  coEnumerate :: Shared f (Bool -> b)
coEnumerate = Shareable f (Bool -> b) -> Shared f (Bool -> b)
forall a b (f :: * -> *).
(Typeable a, Enumerable b, Sized f, Typeable f) =>
Shareable f (a -> b) -> Shared f (a -> b)
function (Shareable f (Bool -> b) -> Shared f (Bool -> b))
-> Shareable f (Bool -> b) -> Shared f (Bool -> b)
forall a b. (a -> b) -> a -> b
$ (b -> b -> Bool -> b) -> Shareable f (Bool -> b)
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 ((b -> b -> Bool -> b) -> Shareable f (Bool -> b))
-> (b -> b -> Bool -> b) -> Shareable f (Bool -> b)
forall a b. (a -> b) -> a -> b
$ \b
x b
y Bool
b -> if Bool
b then b
x else b
y

instance CoEnumerable a => CoEnumerable [a] where
  coEnumerate :: Shared f ([a] -> b)
coEnumerate = Shareable f ([a] -> b) -> Shared f ([a] -> b)
forall a b (f :: * -> *).
(Typeable a, Enumerable b, Sized f, Typeable f) =>
Shareable f (a -> b) -> Shared f (a -> b)
function (Shareable f ([a] -> b) -> Shared f ([a] -> b))
-> Shareable f ([a] -> b) -> Shared f ([a] -> b)
forall a b. (a -> b) -> a -> b
$ (b -> (a -> [a] -> b) -> [a] -> b) -> Shareable f ([a] -> b)
forall a b (f :: * -> *) x.
(Enumerable a, Enumerable b, Sized f, Typeable f) =>
(a -> b -> x) -> Shareable f x
c2 ((b -> (a -> [a] -> b) -> [a] -> b) -> Shareable f ([a] -> b))
-> (b -> (a -> [a] -> b) -> [a] -> b) -> Shareable f ([a] -> b)
forall a b. (a -> b) -> a -> b
$
    \b
uf a -> [a] -> b
cf [a]
xs -> case [a]
xs of
       []      -> b
uf
       (a
x:[a]
xs)  -> a -> [a] -> b
cf a
x [a]
xs






deriveEnumerable :: Name -> Q [Dec]
deriveEnumerable :: Name -> Q [Dec]
deriveEnumerable = ConstructorDeriv -> Q [Dec]
deriveEnumerable' (ConstructorDeriv -> Q [Dec])
-> (Name -> ConstructorDeriv) -> Name -> Q [Dec]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> ConstructorDeriv
dAll


type ConstructorDeriv = (Name, [(Name, ExpQ)])
dAll :: Name -> ConstructorDeriv
dAll :: Name -> ConstructorDeriv
dAll Name
n = (Name
n,[])
dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
dExcluding :: Name -> ConstructorDeriv -> ConstructorDeriv
dExcluding Name
n (Name
t,[(Name, ExpQ)]
nrs) = (Name
t,(Name
n,[|empty|])(Name, ExpQ) -> [(Name, ExpQ)] -> [(Name, ExpQ)]
forall a. a -> [a] -> [a]
:[(Name, ExpQ)]
nrs)
dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
dExcept :: Name -> ExpQ -> ConstructorDeriv -> ConstructorDeriv
dExcept Name
n ExpQ
e (Name
t,[(Name, ExpQ)]
nrs) = (Name
t,(Name
n,ExpQ
e)(Name, ExpQ) -> [(Name, ExpQ)] -> [(Name, ExpQ)]
forall a. a -> [a] -> [a]
:[(Name, ExpQ)]
nrs)

-- | Derive an instance of Enumberable with Template Haskell, with
-- rules for some specific constructors
deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
deriveEnumerable' :: ConstructorDeriv -> Q [Dec]
deriveEnumerable' (Name
n,[(Name, ExpQ)]
cse) =
  (Dec -> [Dec]) -> Q Dec -> Q [Dec]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Dec -> [Dec]
forall (m :: * -> *) a. Monad m => a -> m a
return (Q Dec -> Q [Dec]) -> Q Dec -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ Name -> [[(Name, [Type])] -> Q Dec] -> Name -> Q Dec
instanceFor ''Enumerable [[(Name, [Type])] -> Q Dec
enumDef] Name
n
  where
    enumDef :: [(Name,[Type])] -> Q Dec
    enumDef :: [(Name, [Type])] -> Q Dec
enumDef [(Name, [Type])]
cons = do
      Q ()
sanityCheck
      (Exp -> Dec) -> ExpQ -> Q Dec
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Exp -> Dec
mk_freqs_binding [|datatype $ex |]
      where
        ex :: ExpQ
ex = [ExpQ] -> ExpQ
listE ([ExpQ] -> ExpQ) -> [ExpQ] -> ExpQ
forall a b. (a -> b) -> a -> b
$ ((Name, [Type]) -> ExpQ) -> [(Name, [Type])] -> [ExpQ]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [Type]) -> ExpQ
forall b. (Name, [b]) -> ExpQ
cone [(Name, [Type])]
cons
        cone :: (Name, [b]) -> ExpQ
cone xs :: (Name, [b])
xs@(Name
n,[b]
_) = ExpQ -> (ExpQ -> ExpQ) -> Maybe ExpQ -> ExpQ
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Name, [b]) -> ExpQ
forall b. (Name, [b]) -> ExpQ
cone' (Name, [b])
xs) ExpQ -> ExpQ
forall a. a -> a
id (Maybe ExpQ -> ExpQ) -> Maybe ExpQ -> ExpQ
forall a b. (a -> b) -> a -> b
$ Name -> [(Name, ExpQ)] -> Maybe ExpQ
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup Name
n [(Name, ExpQ)]
cse
        cone' :: (Name, [b]) -> ExpQ
cone' (Name
n,[]) = [|c0 $(conE n)|]
        cone' (Name
n,b
_:[b]
vs) =
          [|c1 $(foldr appE (conE n) (map (const [|uncurry|] ) vs) )|]
        mk_freqs_binding :: Exp -> Dec
        mk_freqs_binding :: Exp -> Dec
mk_freqs_binding Exp
e = Pat -> Body -> [Dec] -> Dec
ValD (Name -> Pat
VarP 'enumerate ) (Exp -> Body
NormalB Exp
e) []
        sanityCheck :: Q ()
sanityCheck = case (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> [Name] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` ((Name, [Type]) -> Name) -> [(Name, [Type])] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, [Type]) -> Name
forall a b. (a, b) -> a
fst [(Name, [Type])]
cons) (((Name, ExpQ) -> Name) -> [(Name, ExpQ)] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map (Name, ExpQ) -> Name
forall a b. (a, b) -> a
fst [(Name, ExpQ)]
cse) of
          [] -> () -> Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          [Name]
xs -> [Char] -> Q ()
forall a. HasCallStack => [Char] -> a
error ([Char] -> Q ()) -> [Char] -> Q ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid constructors for "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++Name -> [Char]
forall a. Show a => a -> [Char]
show Name
n[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
": "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Name] -> [Char]
forall a. Show a => a -> [Char]
show [Name]
xs