| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Enumerate.Types
Contents
Description
enumerate all values in a finite type.
e.g.
data A = A0 Bool | A1 (Either Bool) (Maybe Bool) | A2 (Bool, Bool) | A3 (Set Bool) deriving (Show,Generic,Enumerable) > enumerate A0 False A0 True A1 ... > cardinality ([]::[A])
see the Enumerable class for documentation.
see Enumerate.Example for examples.
can also help automatically derive QuickCheck instances:
newtype ValidString = ValidString String deriving (Show) validStrings :: [String] makeValidString :: String -> Maybe ValidString makeValidString s = if smembervalidStrings then Just (ValidString s) else Nothing instanceEnumerableValidString where enumerated = ValidString <$> validStrings ... -- manually (since normal String's are infinite) instance Arbitrary ValidString where arbitrary = elementsenumerateddata ValidName = ValidName ValidString ValidString | CoolValidName [ValidString] deriving (Show,Generic) instanceEnumerableValidName -- automatically instance Arbitrary ValidName where arbitrary = elementsenumerated
Provides instances for all base types (whenever possible):
- under
Data./Control./System./Text., and evenGHC. - even non-
Enums - except when too large (like
Int) (see Enumerate.Large)
background on Generics:
also provides instances for:
- sets
- vinyl records
related packages:
- enumerable.
no
Genericinstance. - universe
no
Genericinstance. - SafeEnum
only
Enums - emgm. allows infinite lists (by convention). too heavyweight.
- testing-feat. too heavyweight (testing framework).
- smallcheck too heavyweight (testing framework). Series enumerates up to some depth and can enumerated infinitely-inhabited types.
- quickcheck too heavyweight (testing framework, randomness unnecessary).
- class Enumerable a where
- newtype WrappedBoundedEnum a = WrappedBoundedEnum {
- unwrapBoundedEnum :: a
- class GEnumerable f where
- boundedEnumerated :: (Bounded a, Enum a) => [a]
- boundedCardinality :: forall proxy a. (Bounded a, Enum a) => proxy a -> Natural
- enumEnumerated :: Enum a => [a]
- indexedEnumerated :: (Bounded a, Ix a) => [a]
- indexedCardinality :: forall proxy a. (Bounded a, Ix a) => proxy a -> Natural
- enumerateBelow :: forall a. Enumerable a => Natural -> Either Natural [a]
- enumerateTimeout :: (Enumerable a, NFData a) => Int -> IO (Maybe [a])
modular integers
>>>import Prelude
class Enumerable a where Source #
enumerate the set of all values in a (finitely enumerable) type. enumerates depth first.
generalizes Enums to any finite/discrete type. an Enumerable is either:
- an Enum
- a product of Enumerables
- a sum of Enumerables
can be implemented automatically via its Generic instance.
laws:
finite:
cardinality/= _|_
consistent:
so you can index the
enumeratedwith a nonnegative index below thecardinality.distinct:
(Eq a) =>
nubenumerated==enumerated
complete:
x `
elem'enumerated
coincides with
BoundedEnums:(
Enuma,Boundeda) =>enumerated==boundedEnumerated(
Enuma) =>enumerated==enumEnumerated
(Bounded constraint elided for convenience, but relevant.)
("inputs" a type, outputs a list of values).
Every type in base (that can be an instance) is an instance.
Methods
enumerated :: [a] Source #
enumerated :: (Generic a, GEnumerable (Rep a)) => [a] Source #
cardinality :: proxy a -> Natural Source #
Instances
newtype WrappedBoundedEnum a Source #
wrap any (Bounded a, Enum a) to be a Enumerable via boundedEnumerated.
(avoids OverlappingInstances).
Constructors
| WrappedBoundedEnum | |
Fields
| |
Instances
| (Bounded a, Enum a) => Enumerable (WrappedBoundedEnum a) Source # | |
class GEnumerable f where Source #
"Generic Enumerable", lifted to unary type constructors.
Minimal complete definition
Instances
| GEnumerable V1 Source # | empty list |
| GEnumerable U1 Source # | singleton list |
| Enumerable a => GEnumerable (K1 R a) Source # | call |
| (GEnumerable f, GEnumerable g) => GEnumerable ((:+:) f g) Source # | add lists with |
| (GEnumerable f, GEnumerable g) => GEnumerable ((:*:) f g) Source # | multiply lists with |
| GEnumerable f => GEnumerable (M1 D t f) Source # | ignore datatype metadata |
| GEnumerable f => GEnumerable (M1 C t f) Source # | ignore constructor metadata |
| GEnumerable f => GEnumerable (M1 S t f) Source # | ignore selector metadata |
boundedEnumerated :: (Bounded a, Enum a) => [a] Source #
for non-Generic Bounded Enums:
instance Enumerable _ whereenumerated= boundedEnumeratedcardinality=boundedCardinality
boundedCardinality :: forall proxy a. (Bounded a, Enum a) => proxy a -> Natural Source #
for non-Generic Bounded Enums.
Assuming Bounded is correct, safely stop the enumeration
(and know where to start).
behavior may be undefined when the cardinality of a is larger than
the cardinality of Int. this should be okay, as Int is at least as big as
Int64, which is at least as big as all the monomorphic types in base that
instantiate Bounded. you can double-check with:
>>>boundedCardinality (const(undefined::Int)) -- platform specific18446744073709551616
-- i.e. 1 + 9223372036854775807 - (-9223372036854775808)
works with non-zero-based Enum instances, like Int64 or a custom
toEnum/fromEnum. assumes the enumeration's numbering is
contiguous, e.g. if fromEnum 0 and fromEnum 2
both exist, then fromEnum 1 should exist too.
enumEnumerated :: Enum a => [a] Source #
for non-Generic Enums:
instance Enumerable ... where
enumerated = enumEnumerated
the enum should still be bounded.
indexedEnumerated :: (Bounded a, Ix a) => [a] Source #
for non-Generic Bounded Indexed (Ix) types:
instance Enumerable _ whereenumerated= indexedEnumeratedcardinality=indexedCardinality
enumerateBelow :: forall a. Enumerable a => Natural -> Either Natural [a] Source #
enumerate only when the cardinality is small enough. returns the cardinality when too large.
>>>enumerateBelow 2 :: Either Natural [Bool]Left 2
>>>enumerateBelow 100 :: Either Natural [Bool]Right [False,True]
useful when you've established that traversing a list below some length and consuming its values is reasonable for your application. e.g. after benchmarking, you think you can process a billion entries within a minute.
enumerateTimeout :: (Enumerable a, NFData a) => Int -> IO (Maybe [a]) Source #
enumerate only when completely evaluating the list doesn't timeout (before the given number of microseconds).
>>>enumerateTimeout (2 * 10^6) :: IO (Maybe [Bool]) -- two secondsJust [False,True]