packages feed

enumerate (empty) → 0.0.0

raw patch · 14 files changed

+1488/−0 lines, 14 filesdep +MemoTriedep +basedep +containerssetup-changed

Dependencies added: MemoTrie, base, containers, deepseq, enumerate, exceptions, ghc-prim, modular-arithmetic, semigroups, template-haskell, vinyl

Files

+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2015 Sam Boosalis++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+import Data.Enumerate.Example
+ README.md view
@@ -0,0 +1,6 @@+# enumerate+enumerate all the values in a finite type (automatically) ++## (extensive) documentation+https://hackage.haskell.org/package/enumerate+
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ enumerate.cabal view
@@ -0,0 +1,66 @@+-- Initial enumerate.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                enumerate+version:             0.0.0+synopsis:            enumerate all the values in a finite type (automatically)+description:         provides a typeclass, a generic instance for automatic deriving, and helpers that reify functions (partial or total, monadic or pure) into a Map +homepage:            https://github.com/sboosali/enumerate+license:             MIT+license-file:        LICENSE+author:              Sam Boosalis+maintainer:          samboosalis@gmail.com+-- copyright:           +category:            Data+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10+tested-with:         GHC ==7.10.2++source-repository head+ type:     git+ location: git://github.com/sboosali/enumerate.git++library+ exposed-modules:  +  Data.Enumerate+  Data.Enumerate.Types +  Data.Enumerate.Reify +  Data.Enumerate.Domain+  Data.Enumerate.Example+  Data.Enumerate.Map+  Data.Enumerate.Extra+  Data.Enumerate.Large +  Data.Enumerate.Function+  -- Data.CoRec+  -- Data.CoRec.MemoTrie++ build-depends:    +     base >=4.8 && <4.9+   , containers ==0.5.* +   , ghc-prim==0.4.*++   , semigroups ==0.16.*+   , exceptions ==0.8.*+   , MemoTrie ==0.6.*+--   , spoon ==0.3.*+   , deepseq ==1.4.*++   , vinyl==0.5.* +   , modular-arithmetic==1.2.* +   , template-haskell  ==2.10.*++ hs-source-dirs:      sources+ default-language:    Haskell2010+++executable example ++ main-is:  Main.hs + hs-source-dirs:      . + default-language:    Haskell2010++ build-depends:    +     base >=4.8 && <4.9+   , enumerate ==0.0.0 +
+ sources/Data/Enumerate.hs view
@@ -0,0 +1,23 @@+{-| see "Data.Enumerable.Types" for detailed documentation. ++to import every symbol in this package, run this in GHCi:++@+:m +  Data.Enumerate  Data.Enumerate.Extra  Data.Enumerate.Large  Data.Enumerate.Function +@++the modules "Data.Enumerate.Large" and "Data.Enumerate.Function" have orphan instances for large types, +and aren't reexported by default. +this makes attempting to enumerate them a type error, rather than runtime non-termination. ++-}+module Data.Enumerate+ ( module Data.Enumerate.Types+ , module Data.Enumerate.Reify+ -- , module Data.Enumerate.Domain + , module Data.Enumerate.Map + ) where +import Data.Enumerate.Types+import Data.Enumerate.Reify+-- import Data.Enumerate.Domain+import Data.Enumerate.Map
+ sources/Data/Enumerate/Domain.hs view
@@ -0,0 +1,109 @@+{-# LANGUAGE DeriveGeneric, DefaultSignatures, TypeOperators, FlexibleInstances, FlexibleContexts, DeriveAnyClass, TypeFamilies, LambdaCase, EmptyCase, MultiParamTypeClasses  #-}++{- |++e.g. generate a boilerplate 'HasTrie' instance for a @Context@ type that has both sum types and product types ++@+data Context+ = GlobalContext | EmacsContext BufferName BufferMode BufferContents | OtherContext String+ deriving (Show,Generic) + -- Strings are infinite, so Context is too, that's okay ++instance HasDomain Context ++type BufferName = String+type BufferMode = String+type BufferContents = String++instance HasTrie Context where+ type a :->: b = ContextTrie ('TrieGeneric' a b)+ trie = 'trieGeneric'+ untrie = 'untrieGeneric'+@++the conversions (between a type @a@ and its representation @(Rep a x)@) make the generic instance +slower than a manual instance.++but, if the function you're memoizing is costly enough, and the datatype it consumes is messy enough, +the four-line @HasTrie@ instance (and a one line call to 'memo') can save both runtime and developer time.+++-}+module Data.Enumerate.Domain where +import Data.CoRec++import Data.MemoTrie++import           GHC.Generics+++-- class GHasTrie f a where+--  type GTrie f a :: (* -> *)+--  -- type GTrie f :: (* -> *) -> * -> * -> (* -> *)+--  gtrie :: f p -> (a -> ) -> (GTrie f a) p+--  guntrie :: (GTrie f a) p -> (a -> )+++-- -- | zero cases become (one case with) zero fields+-- instance GHasTrie (V1) a where+--  type GTrie (V1) a = (U1)+--  gtrie _ = (U1)+++-- -- | one case becomes (one case with) one field+-- instance GHasTrie (U1) a where+--  type GTrie (U1) a = (K1 () a)+--  -- gtrie (U1) = (K1 a)+--  gtrie (U1) = undefined ++ +-- -- | call 'trie'+-- instance (HasTrie a) => GHasTrie (K1 i a) where+--  type GTrie (K1 i a) = Trie a +--  gtrie (K1 a) = trie a +++-- -- -- | two cases become (one case with) two fields+-- -- instance (GHasTrie (f), GHasTrie (g)) => GHasTrie (f :+: g) where+-- --  type GTrie (f :+: g) = Either (GTrie f) (GTrie g) +-- --  gtrie (L1 f) = Left  (gtrie f) +-- --  gtrie (R1 g) = Right (gtrie g) +++-- -- -- | two fields become (one case with) (one field of) two arrows+-- -- instance (GHasDomain (f), GHasDomain (g)) => GHasDomain (f :*: g) where+-- --  type GDomain (f :*: g) = ((GDomain f), (GDomain g))+-- --  gdomain (f :*: g) = (gdomain f, gdomain g)+++-- -- -- | (ignore metadata) +-- -- instance (GHasDomain (f)) => GHasDomain (M1 i a f) where+-- --  type GDomain (M1 i a f) =  (GDomain f)+-- --  gdomain (M1 f) = gdomain f+++-- {- | ++-- e.g. ++-- @+-- a ~ Context++-- Rep a ~ ++-- GDomain (Rep a) ~ ++-- GCanonical (GDomain (Rep a)) ~ ++-- @++-- -}+-- -- type TrieGeneric a = GCanonical (GDomain (Rep a))++-- -- trieGeneric :: +-- -- trieGeneric = ++-- -- untrieGeneric :: +-- -- untrieGeneric = +
+ sources/Data/Enumerate/Example.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE LambdaCase, DeriveGeneric, DeriveAnyClass #-}+module Data.Enumerate.Example where +import Data.Enumerate ++import           System.Environment             (getArgs)+import           Data.Void (Void)+import           GHC.Generics (Generic) +++main = mainWith =<< getArgs++mainWith = \case+ _ -> return() +++{- | (for documentation) ++demonstrates: empty type, unit type, product type, sum type, type variable.++with @\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\}@, the derivation is a one-liner: ++@+data DemoEnumerable a = ... deriving (Show,Generic,Enumerable) +@++-}+data DemoEnumerable a+ = DemoEnumerable0 Void+ | DemoEnumerable1+ | DemoEnumerable2 Bool (Maybe Bool) + | DemoEnumerable3 a+ deriving (Show,Generic,Enumerable) ++{- | (for documentation) ++@demoEnumerated = enumerated@++>>> traverse print demoEnumerated+DemoEnumerable1+DemoEnumerable2 False Nothing+DemoEnumerable2 False (Just False)+DemoEnumerable2 False (Just True)+DemoEnumerable2 True Nothing+DemoEnumerable2 True (Just False)+DemoEnumerable2 True (Just True)+DemoEnumerable3 False+DemoEnumerable3 True++-}+demoEnumerated :: [DemoEnumerable Bool] +demoEnumerated = enumerated+
+ sources/Data/Enumerate/Extra.hs view
@@ -0,0 +1,132 @@+{-# LANGUAGE RankNTypes, LambdaCase, ScopedTypeVariables #-}+{-| ++-}+module Data.Enumerate.Extra where++import Control.Monad.Catch (MonadThrow(..), SomeException(..))+import Control.DeepSeq (NFData(..), deepseq) ++-- import Language.Haskell.TH.Syntax (Name,nameBase)+import Control.Arrow ((&&&), (>>>))+import System.IO.Unsafe (unsafePerformIO) +import Control.Exception (catches, throwIO, Handler(..), AsyncException, ArithException, ArrayException, ErrorCall, PatternMatchFail)+import Data.Foldable  (traverse_)+import Numeric.Natural +import qualified Data.Set as Set+import Data.Set (Set) +import qualified Data.List as List +import qualified Data.Ord as Ord+++{-| @failed = 'throwM' . 'userError'@++-}+failed ::  (MonadThrow m) => String -> m a+failed = throwM . userError++-- | generalize a function that fails with @Nothing@. +maybe2throw :: (a -> Maybe b) -> (forall m. MonadThrow m => a -> m b) +maybe2throw f = f >>> \case+ Nothing -> failed "Nothing"+ Just x  -> return x ++-- | generalize a function that fails with @[]@.  +list2throw :: (a -> [b]) -> (forall m. MonadThrow m => a -> m b)+list2throw f = f >>> \case+ []    -> failed "[]"++ (x:_) -> return x++-- | generalize a function that fails with @Left@. +either2throw :: (a -> Either SomeException b) -> (forall m. MonadThrow m => a -> m b)+either2throw f = f >>> \case+ Left  e -> throwM e+ Right x -> return x ++{-| makes an *unsafely*-partial function (i.e. a function that throws exceptions or that has inexhaustive pattern matching) into a *safely*-partial function (i.e. that explicitly returns in a monad that supports failure).+++-}+totalizeFunction :: (NFData b, MonadThrow m) => (a -> b) -> (a -> m b)+totalizeFunction f = g + where g x = spoonWith defaultPartialityHandlers (f x)++{-| handles the following exceptions:  ++* 'ArithException'+* 'ArrayException'+* 'ErrorCall'+* 'PatternMatchFail' ++-}+defaultPartialityHandlers :: (MonadThrow m) => [Handler (m a)]+defaultPartialityHandlers =+    [ Handler $ \(e :: AsyncException)   -> throwIO e -- TODO I hope they are tried in order +    , Handler $ \(e :: ArithException)   -> return (throwM e)+    , Handler $ \(e :: ArrayException)   -> return (throwM e)+    , Handler $ \(e :: ErrorCall)        -> return (throwM e)+    , Handler $ \(e :: PatternMatchFail) -> return (throwM e)+    , Handler $ \(e :: SomeException)    -> return (throwM e)+    ]+{-# INLINEABLE defaultPartialityHandlers #-}++{-| Evaluate a value to normal form and 'throwM' any exceptions are thrown during evaluation. For any error-free value, @spoon = Just@.++taken from the <https://hackage.haskell.org/package/spoon-0.3.1/docs/Control-Spoon.html spoon> package.  ++-}+spoonWith :: (NFData a, MonadThrow m) => [Handler (m a)] -> a -> m a +spoonWith handlers a = unsafePerformIO $ do + deepseq a (return `fmap` return a) `catches` handlers +{-# INLINEABLE spoonWith #-}++{- | the eliminator as a function and the introducer as a string++helper for declaring Show instances of datatypes without visible constructors (like @Map@+which is shown as an list).++-}++showsPrecWith :: (Show a, Show b) => String -> (a -> b) -> Int -> a -> ShowS+showsPrecWith stringFrom functionInto p x = showParen (p > 10) $+  showString stringFrom . showString " " . shows (functionInto x)++-- showsPrecWith :: (Show a, Show b) => Name -> (a -> b) -> Int -> a -> ShowS+-- showsPrecWith nameFrom functionInto p x = showParen (p > 10) $+--   showString (nameBase nameFrom) . showString " " . shows (functionInto x)++int2natural :: Int -> Natural +int2natural = fromInteger . toInteger++{-| the power set of a set of values. ++>>> (powerset2matrix . powerSet . Set.fromList) [1..3]+[[],[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]++-}+powerSet :: (Ord a) => Set a -> Set (Set a) +powerSet values = Set.singleton values `Set.union` _Set_bind powerSet (dropEach values) + where + _Set_bind :: (Ord a, Ord b) => (a -> Set b) -> Set a -> Set b + _Set_bind f = _Set_join . Set.map f + _Set_join :: (Ord a) => Set (Set a) -> Set a+ _Set_join = Set.unions . Set.toList ++{-| >>> (powerset2matrix . dropEach . Set.fromList) [1..3]+[[1,2],[1,3],[2,3]]++-}+dropEach :: (Ord a) => Set a -> Set (Set a) +dropEach values = Set.map dropOne values + where+ dropOne value = Set.delete value values ++{-| convert a power set to an isomorphic matrix, sorting the entries. ++(for doctest) ++-}+powerset2matrix :: Set (Set a) -> [[a]] +powerset2matrix = (List.sortBy (Ord.comparing length) . fmap Set.toList . Set.toList)+
+ sources/Data/Enumerate/Function.hs view
@@ -0,0 +1,231 @@+{-# LANGUAGE TupleSections, ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-| orphan instances, of 'Enumerate'/'Eq'/'Show', for functions. ++(that are included for completeness, but not exported by default (i.e. by "Data.Enumerate"). +you probably want build-time instance-resolution errors rather than possible runtime non-termination). +++@-- doctest@++>>> :set -XLambdaCase +>>> let printMappings mappings = traverse (\mapping -> (putStrLn"") >> (traverse print) mapping) mappings >> return() ++-}+module Data.Enumerate.Function where+import Data.Enumerate.Types +import Data.Enumerate.Reify +import Data.Enumerate.Map+import Data.Enumerate.Extra ++import           Data.Proxy+import qualified Data.Map as Map+++{-| the exponential type. ++the 'cardinality' is the cardinality of @b@ raised to the cardinality @a@, i.e. @|b|^|a|@.++warning: it grows very quickly. ++might be useful for generating random functions on small types, +like to fuzz test type class laws. ++the 'cardinality' call is efficient (depending on the efficiency of the base type's call). +you should be able to safely (WRT performance) call 'enumerateBelow', +unless the arithmetic itself becomes too expensive. ++@enumerated = 'functionEnumerated'@ ++-}+instance (Enumerable a, Enumerable b, Ord a, Ord b) => Enumerable (a -> b) where + enumerated    = functionEnumerated + cardinality _ = cardinality (Proxy :: Proxy b) ^ cardinality (Proxy :: Proxy a) +++{-| brute-force function extensionality. ++warning: the size of the domain grows exponentially in the number of arguments. ++>>> (\case LT -> False; EQ -> False; GT -> False) == const False +True+>>> (\case LT -> False; EQ -> False; GT -> False) == const True +False++because functions are curried, the instance is recursive, and it works on functions of any arity: ++> -- De Morgan's laws+>>> (\x y -> not (x && y)) == (\x y -> not x || not y)+True+>>> (\x y -> not (x || y)) == (\x y -> not x && not y)+True++-}+instance (Enumerable a, Eq b) => Eq (a -> b) where+ f == g = all ((==) <$> f <*> g) enumerated+ f /= g = any ((/=) <$> f <*> g) enumerated+++{-| ++>>> print not +unsafeFromList [(False,True),(True,False)]++because functions are curried, the instance is recursive, and it works on functions of any arity: ++>>> print (&&) +unsafeFromList [(False,unsafeFromList [(False,False),(True,False)]),(True,unsafeFromList [(False,False),(True,True)])]++-}+instance (Enumerable a, Show a, Show b) => Show (a -> b) where+ showsPrec = showsPrecWith "unsafeFromList" reifyFunction+++{-| wraps 'Map.lookup' ++>>> (unsafeFromList [(False,True),(True,False)]) False +True+>>> (unsafeFromList [(False,True),(True,False)]) True +False++-}+unsafeFromList :: (Ord a) => [(a,b)] -> (a -> b)+unsafeFromList l = unsafeToFunction (Map.fromList l) +{-# INLINABLE unsafeFromList #-}++functionEnumerated :: (Enumerable a, Enumerable b, Ord a, Ord b) => [a -> b]+functionEnumerated = functions + where+ functions = (unsafeToFunction . Map.fromList) <$> mappings + mappings = mappingEnumeratedAt enumerated enumerated+++{-| @[(a,b)]@ is a mapping, @[[(a,b)]]@ is a list of mappings. ++>>> let orderingPredicates = mappingEnumeratedAt [LT,EQ,GT] [False,True] +>>> print $ length orderingPredicates +8+>>> printMappings $ orderingPredicates +<BLANKLINE>+(LT,False)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,True)+(LT,False)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,False)+(EQ,True)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,False)+(GT,True)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,False)+<BLANKLINE>+(LT,True)+(EQ,True)+(GT,True)++where the (total) mapping:++@+(LT,False)+(EQ,False)+(GT,True)+@++is equivalent to the function:++@+\\case+ LT -> False+ EQ -> False+ GT -> True+@+++-}+mappingEnumeratedAt :: [a] -> [b] -> [[(a,b)]]           -- TODO diagonalize? performance? +mappingEnumeratedAt as bs = go (crossProduct as bs)+ where+ go [] = [] + go [somePairs] = do+  pair <- somePairs +  return$ [pair]+ go (somePairs:theProduct) = do+  pair <- somePairs +  theExponent <- go theProduct +  return$ pair : theExponent ++{-| ++>>> let crossOrderingBoolean = crossProduct [LT,EQ,GT] [False,True]+>>> printMappings $ crossOrderingBoolean +>>> +(LT,False)+(LT,True)+<BLANKLINE>+(EQ,False)+(EQ,True)+<BLANKLINE>+(GT,False)+(GT,True)++the length of the outer list is the size of the first set and +the length of the inner list is the size of the second set. ++>>> print $ length crossOrderingBoolean+3+>>> print $ length (head crossOrderingBoolean)+2++-}+crossProduct :: [a] -> [b] -> [[(a,b)]] +crossProduct [] _ = [] +crossProduct (aValue:theDomain) theCodomain =+ fmap (aValue,) theCodomain : crossProduct theDomain theCodomain+
+ sources/Data/Enumerate/Large.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE TupleSections #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-| orphan instances, of 'Enumerate', for large types (i.e. @Word32@ / @Word64@ / @Int32@ / @Int64@).++(that are included for completeness, but not exported by default (i.e. by "Data.Enumerate"). +you probably want build-time instance-resolution errors rather than probable runtime non-termination). ++-}+module Data.Enumerate.Large where+import Data.Enumerate.Types ++import           Data.Word (Word32, Word64)+import           Data.Int (Int32, Int64)+++instance Enumerable Int32  where enumerated = boundedEnumerated; cardinality = boundedCardinality +instance Enumerable Word32 where enumerated = boundedEnumerated; cardinality = boundedCardinality ++{-| finite but too big. @2^64@ is over a billion billion (@1,000,000,000,000@). ++e.g. 'Enumerate.reifyFunction' (which takes time linear in the domain) on a function of type @(:: Int -> Bool)@, even a lazy one, won't terminate anytime soon.  ++-}+instance Enumerable Int64  where enumerated = boundedEnumerated; cardinality = boundedCardinality +instance Enumerable Word64 where enumerated = boundedEnumerated; cardinality = boundedCardinality +
+ sources/Data/Enumerate/Map.hs view
@@ -0,0 +1,302 @@+{-# LANGUAGE RankNTypes, LambdaCase #-}+{-| converting between partial functions and maps.  ++@-- doctest@++>>> :set +m+>>> :set -XLambdaCase +>>> :{+let uppercasePartial :: (MonadThrow m) => Char -> m Char  -- Partial Char Char +    uppercasePartial = \case+     'a' -> return 'A'+     'b' -> return 'B'+     'z' -> return 'Z'+     _   -> failed "uppercasePartial"+:}++a (safely-)partial function is isomorphic with a @Map@: ++@+'fromFunctionM' . 'toFunctionM' = 'id' +'toFunctionM' . 'fromFunctionM' = 'id'+@++modulo the error thrown. ++-}+module Data.Enumerate.Map where+import Data.Enumerate.Extra +import Data.Enumerate.Types+import Data.Enumerate.Reify ++import Control.Monad.Catch (MonadThrow(..))+import           Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NonEmpty+import Data.Semigroup                   ((<>))++import qualified Data.Map as Map+import           Data.Map (Map)+import qualified Data.Set as Set+import           Data.Set (Set)+import           Data.Maybe (fromJust, mapMaybe, listToMaybe) +import           Control.Exception(PatternMatchFail(..)) ++{- | convert a total function to a map. ++@+>>> fromFunction 'not' +fromList [(False,True),(True,False)]+@++-}+fromFunction :: (Enumerable a, Ord a) => (a -> b) -> Map a b+fromFunction f = fromFunctionM (return.f) +{-# INLINABLE fromFunction #-}++{- | convert a (safely-)partial function to a map. ++wraps 'reifyFunctionM'.  ++-}+fromFunctionM :: (Enumerable a, Ord a) => (Partial a b) -> Map a b+fromFunctionM f = Map.fromList (reifyFunctionM f)+{-# INLINABLE fromFunctionM #-}++{- | convert a map to a function, if the map is total. ++@+>>> let Just not' = toFunction (Map.fromList [(False,True),(True,False)])+>>> not' False +True +@++-} +toFunction :: (Enumerable a, Ord a) => Map a b -> Maybe (a -> b)+toFunction m = if isMapTotal m then Just f else Nothing + where f = unsafeToFunction m -- the fromJust is safe when the map is total +{-# INLINABLE toFunction #-}++{- | convert a (safely-)partial function to a map. ++lookup failures are 'throwM'n as a 'PatternMatchFail'. ++@+>>> let idPartial = toFunctionM (Map.fromList [(True,True)])+>>> idPartial True+True+>>> idPartial False +*** Exception: toFunctionM+@++-} +toFunctionM :: (Enumerable a, Ord a) => Map a b -> (Partial a b)+toFunctionM m = f + where+ f x = maybe (throwM (PatternMatchFail "toFunctionM")) return (Map.lookup x m)+{-# INLINABLE toFunctionM #-}++{-| wraps 'Map.lookup' ++-}+unsafeToFunction :: (Ord a) => Map a b -> (a -> b)+unsafeToFunction m x = fromJust (Map.lookup x m)+{-# INLINABLE unsafeToFunction #-}++{-| does the map contain every key in its domain? ++>>> isMapTotal (Map.fromList [(False,True),(True,False)]) +True ++>>> isMapTotal (Map.fromList [('a',0)]) +False ++-}+isMapTotal :: (Enumerable a, Ord a) => Map a b -> Bool+isMapTotal m = all (\x -> Map.member x m) enumerated ++{-| safely invert any map. ++-}+invertMap :: (Ord a, Ord b) => Map a b -> Map b (NonEmpty a) +invertMap m = Map.fromListWith (<>) [(b, a:|[]) | (a, b) <- Map.toList m]++{-| refines the partial function, if total.++>>> :{ +let myNotM :: Monad m => Bool -> m Bool+    myNotM False = return True +    myNotM True  = return False +:} +>>> let Just myNot = isTotalM myNotM+>>> myNot False +True++-}+isTotalM :: (Enumerable a, Ord a) => (Partial a b) -> Maybe (a -> b) +isTotalM f = (toFunction) (fromFunctionM f)++{-| the <https://en.wikipedia.org/wiki/Partial_function#Basic_concepts domain> of a partial function +is the subset of the 'enumerated' input where it's defined. ++i.e. when @x \`member\` (domainM f)@ then @fromJust (f x)@ is defined. ++>>> domainM uppercasePartial+['a','b','z'] ++-}+domainM :: (Enumerable a) => (Partial a b) -> [a] +domainM f = foldMap go enumerated+ where+ go a = case f a of +   Nothing -> [] +   Just{}  -> [a]++{-| (right name?) ++@corange _ = enumerated@ ++-}+corange :: (Enumerable a) => (a -> b) -> [a] +corange _ = enumerated ++{-| ++@corangeM _ = enumerated@ ++-}+corangeM :: (Enumerable a) => (Partial a b) -> [a] +corangeM _ = enumerated ++{-| the image of a total function. ++@imageM f = map f 'enumerated'@++includes duplicates.  ++-}+image :: (Enumerable a) => (a -> b) -> [b] +image f = map f enumerated++{-| the image (not the 'codomain') of a partial function. ++@imageM f = mapMaybe f 'enumerated'@++includes duplicates.  ++-}+imageM :: (Enumerable a) => (Partial a b) -> [b] +imageM f = mapMaybe f enumerated++{-| the codomain of a function. it contains the 'image'. ++@codomain _ = enumerated@ ++-}+codomain :: (Enumerable b) => (a -> b) -> [b]  +codomain _ = enumerated ++codomainM :: (Enumerable b) => (Partial a b) -> [b] +codomainM _ = enumerated ++{-| invert a total function.++@(invert f) b@ is: ++* @[]@ wherever @f@ is not surjective +* @[y]@ wherever @f@ is uniquely defined +* @(_:_)@ wherever @f@ is not injective ++@invert f = 'invertM' (return.f)@++-}+invert :: (Enumerable a, Ord a, Ord b) => (a -> b) -> (b -> [a])+invert f = invertM (return.f) ++{-| invert a partial function.++@(invertM f) b@ is: ++* @[]@ wherever @f@ is partial +* @[]@ wherever @f@ is not surjective +* @[y]@ wherever @f@ is uniquely defined +* @(_:_)@ wherever @f@ is not injective ++a @Map@ is stored internally, with as many keys as the 'image' of @f@. ++see also 'isBijectiveM'.++-}+invertM :: (Enumerable a, Ord a, Ord b) => (Partial a b) -> (b -> [a])+invertM f = g+ where+ g b = maybe [] NonEmpty.toList (Map.lookup b m)+ m = invertMap (fromFunctionM f) -- share the map ++{-| ++-}+getJectivityM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe Jectivity +getJectivityM f+ = case isBijectiveM f of       -- TODO pick the right Monoid, whose append picks the first non-nothing +    Just{}  -> Just Bijective+    Nothing -> case isInjectiveM f of+                Just{}  -> Just Injective +                Nothing -> case isSurjectiveM f of+                            Just{}  -> Just Surjective+                            Nothing -> Nothing +++{-| returns the inverse of the injection, if injective.++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> Maybe a)@. ++unlike 'isBijectiveM', doesn't need an @(Enumerable b)@ constraint. this helps when you want to ensure a function into an infinite type (e.g. 'show') is injective. and still reasonably efficient, given the @(Ord b)@ constraint. ++-}+isInjectiveM :: (Enumerable a, Ord a, Ord b) => (Partial a b) -> Maybe (b -> Maybe a)+isInjectiveM f = do             -- TODO make it "correct by construction", rather than explicit validation + _bs <- isUnique (imageM f)   -- Map.fromListWith (<>) [(b, a:|[]) | (a, b) <- Map.toList m]+ return g + where+ g = listToMaybe . invertM f+-- can short-circuit. ++{-| converts the list into a set, if it has no duplicates. ++-}+isUnique :: (Ord a) => [a] -> Maybe (Set a) +isUnique l = if length l == length s then Nothing else Just s -- TODO make efficient, maybe single pass with Control.Foldl+ where+ s = Set.fromList l++{-| returns the inverse of the surjection, if surjective. +i.e. when a function's 'codomainM' equals its 'imageM'. ++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> NonEmpty a)@. ++can short-circuit. ++-}+isSurjectiveM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe (b -> NonEmpty a)+isSurjectiveM f =  -- TODO make it "correct by construction", rather than explicit validation + if (Set.fromList (codomainM f)) `Set.isSubsetOf` (Set.fromList (imageM f))  -- the reverse always holds, no need to check  + then Just g+ else Nothing+ where+ g = NonEmpty.fromList . invertM f  -- safe, by validation ++{-| returns the inverse of the bijection, if bijective.++refines @(b -> [a])@ (i.e. the type of 'invertM') to @(b -> a)@. ++can short-circuit. ++-}+isBijectiveM :: (Enumerable a, Enumerable b, Ord a, Ord b) => (Partial a b) -> Maybe (b -> a)+isBijectiveM f = do + fIn    <- isInjectiveM f+ _fSur  <- isSurjectiveM f --   TODO avoid re-computing invertM. isInjectiveWithM isSurjectiveWithM+ let fBi = (fromJust . fIn)  -- safe, because the intersection of "zero or one" with "one or more" is "one" + return fBi+-- let fOp = invertMap (fromFunctionM f) -- share the map +
+ sources/Data/Enumerate/Reify.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE RankNTypes, LambdaCase #-}+{-| see 'reifyFunctionAtM'.  ++@-- doctest@++>>> :set +m++-}+module Data.Enumerate.Reify where+import Data.Enumerate.Types +import Data.Enumerate.Extra ++import Control.Monad.Catch (MonadThrow(..), SomeException(..)) +import Control.DeepSeq (NFData) ++import Control.Arrow ((&&&))+++{- | reify a total function. ++@+>>> reifyFunction 'not'+[(False,True),(True,False)]+@++-} +reifyFunction :: (Enumerable a) => (a -> b) -> [(a,b)]+reifyFunction f = reifyFunctionM (return . f)+{-# INLINABLE reifyFunction #-}++-- | reify a total function at any subset of the domain. +reifyFunctionAt :: [a] -> (a -> b) -> [(a,b)]+reifyFunctionAt domain f = reifyFunctionAtM domain (return . f)+{-# INLINABLE reifyFunctionAt #-}++-- | reify a (safely-)partial function into a map (which is implicitly partial, where @Map.lookup@ is like @($)@.+reifyFunctionM :: (Enumerable a) => (forall m. MonadThrow m => a -> m b) -> [(a,b)]+reifyFunctionM = reifyFunctionAtM enumerated+{-# INLINABLE reifyFunctionM #-}++{- | reify a (safely-)partial function at any domain. ++use the functions suffixed with @M@ when your function is explicitly partial, +i.e. of type @(forall m. MonadThrow m => a -> m b)@. +when inside a function arrow, like:  ++@+reifyFunctionAtM :: [a] -> (forall m. MonadThrow m => a -> m b) -> [(a,b)]+reifyFunctionAtM domain f = ... +@++the @Rank2@ type (and non-concrete types) means that @f@ can only use +parametric polymorphic functions, or the methods of the @MonadThrow@ class +(namely 'throwM'), or methods of @MonadThrow@ superclasses (namely 'return', et cetera). ++'MonadThrow' is a class from the @exceptions@ package that generalizes failibility. +it has instances for @Maybe@, @Either@, @[]@, @IO@, and more.     ++use the functions suffixed with @At@ when your domain isn't 'Enumerable', +or when you want to restrict the domain.+ +the most general function in this module.++>>> :{+let uppercasePartial :: (MonadThrow m) => Char -> m Char +    uppercasePartial c = case c of+     'a' -> return 'A'+     'b' -> return 'B'+     'z' -> return 'Z'+     _   -> failed "uppercasePartial"+:}++@+>>> reifyFunctionAtM ['a'..'c'] uppercasePartial+[('a','A'),('b','B')] +@++if your function doesn't fail under 'MonadThrow', see: ++* 'reifyFunctionAtMaybe'+* 'reifyFunctionAtList'+* 'reifyFunctionAtEither'++-}+reifyFunctionAtM :: [a] -> (Partial a b) -> [(a,b)]+-- reifyFunctionAtM :: (MonadThrow m) => [a] -> (a -> m b) -> m (Map a b)+reifyFunctionAtM domain f + = concatMap (bitraverse pure id)+ . fmap (id &&& f)+ $ domain+ where+ bitraverse f g (x,y) = (,) <$> f x <*> g y  -- avoid bifunctors dependency++-- | @reifyPredicateAt = 'flip' 'filter'@+reifyPredicateAt :: [a] -> (a -> Bool) -> [a]+reifyPredicateAt = flip filter+-- reifyPredicateAtM domain p = map fst (reifyFunctionAtM domain f)+--  where+--  f x = if p x then return x else throwM (ErrorCall "False")++-- MonadThrow Maybe	 +-- (e ~ SomeException) => MonadThrow (Either e)+-- MonadThrow []	 ++-- | reify a (safely-)partial function that fails specifically under @Maybe@. +reifyFunctionMaybeAt :: [a] -> (a -> Maybe b) -> [(a, b)]+reifyFunctionMaybeAt domain f = reifyFunctionAtM domain (maybe2throw f)+{-# INLINABLE reifyFunctionMaybeAt #-}++-- | reify a (safely-)partial function that fails specifically under @[]@. +reifyFunctionListAt :: [a] -> (a -> [b]) -> [(a, b)]+reifyFunctionListAt domain f = reifyFunctionAtM domain (list2throw f)+{-# INLINABLE reifyFunctionListAt #-}++-- | reify a (safely-)partial function that fails specifically under @Either SomeException@. +reifyFunctionEitherAt :: [a] -> (a -> Either SomeException b) -> [(a, b)]+reifyFunctionEitherAt domain f = reifyFunctionAtM domain (either2throw f)+{-# INLINABLE reifyFunctionEitherAt #-}++{-| reifies an *unsafely*-partial function (i.e. a function that throws exceptions or that has inexhaustive pattern matching).++forces the function to be strict.++@+>>> import Data.Ratio (Ratio) +>>> fmap (1/) [0..3 :: Ratio Integer]+[*** Exception: Ratio has zero denominator+>>> let (1/) = reciprocal +>>> reifyFunctionSpoonAt [0..3 :: Ratio Integer] reciprocal +[(1 % 1,1 % 1),(2 % 1,1 % 2),(3 % 1,1 % 3)]+@++normal caveats from violating purity (via @unsafePerformIO@) and from catchalls (via @(e :: SomeExceptions -> _)@) apply.++-}+reifyFunctionSpoonAt :: (NFData b) => [a] -> (a -> b) -> [(a, b)]+reifyFunctionSpoonAt domain f = reifyFunctionMaybeAt domain (totalizeFunction f)++-- | reify a binary total function+reifyFunction2 :: (Enumerable a, Enumerable b) => (a -> b -> c) -> [(a,[(b,c)])]+reifyFunction2 f = reifyFunction2At enumerated enumerated f+{-# INLINABLE reifyFunction2 #-}++-- | reify a binary total function at some domain+reifyFunction2At :: [a] -> [b] -> (a -> b -> c) -> [(a,[(b,c)])]+reifyFunction2At as bs f = reifyFunction2AtM as bs (\x y -> pure (f x y))+{-# INLINABLE reifyFunction2At #-}++-- | reify a binary (safely-)partial function+reifyFunction2M :: (Enumerable a, Enumerable b) => (forall m. MonadThrow m => a -> b -> m c) -> [(a,[(b,c)])]+reifyFunction2M f = reifyFunction2AtM enumerated enumerated f+{-# INLINABLE reifyFunction2M #-}++-- | reify a binary (safely-)partial function at some domain +reifyFunction2AtM :: [a] -> [b] -> (forall m. MonadThrow m => a -> b -> m c) -> [(a,[(b,c)])]+reifyFunction2AtM as bs f = reifyFunctionAt as (\a -> reifyFunctionAtM bs (f a))+
+ sources/Data/Enumerate/Types.hs view
@@ -0,0 +1,360 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables, DefaultSignatures, TypeOperators, FlexibleInstances, FlexibleContexts, LambdaCase #-}+{- | see the 'Enumerable' class for documentation.  ++see "Data.Enumerate.Example" for examples. ++can also help automatically derive <https://hackage.haskell.org/package/QuickCheck/docs/Test-QuickCheck-Arbitrary.html @QuickCheck@> instances: ++@+newtype SmallNatural = ...   +instance Enumerable SmallNatural where ...   +newtype SmallString = ...   +instance Enumerable SmallString where  ...   +data T = C0 | C1 () Bool SmallNatural SmallString | C2 ...  +instance Arbitrary T where arbitrary = elements 'enumerated' +@+++background on @Generics@: ++* <https://hackage.haskell.org/package/base-4.8.1.0/docs/GHC-Generics.html GHC.Generics>+++related packages:++* <http://hackage.haskell.org/package/emgm-0.4/docs/Generics-EMGM-Functions-Enum.html emgm>.  allows infinite lists (by convention). too heavyweight. ++* <http://hackage.haskell.org/package/enumerable enumerable>. no @Generic@ instance. ++* <https://hackage.haskell.org/package/testing-feat-0.4.0.2/docs/Test-Feat-Class.html#t:Enumerable testing-feat>. too heavyweight (testing framework). ++* <https://hackage.haskell.org/package/smallcheck smallcheck> too heavyweight (testing framework). Series enumerates up to some depth and can enumerated infinitely-inhabited types. ++* https://hackage.haskell.org/package/quickcheck quickcheck> too heavyweight (testing framework, randomness unnecessary).++-}++module Data.Enumerate.Types where+import Data.Enumerate.Extra ++import Data.Modular+import Control.Monad.Catch (MonadThrow(..))++import           GHC.Generics+import           Data.Proxy+import           Control.Arrow ((&&&))+import           Data.List (genericLength)+import           Data.Void (Void)+import           Data.Word (Word8, Word16)+import           Data.Int (Int8, Int16)+import qualified Data.Set as Set+import Data.Set (Set) +import System.Timeout+import Control.DeepSeq (NFData,force)+import GHC.TypeLits+import Numeric.Natural+import Data.Ix+++{- | enumerate the set of all values in a (finitely enumerable) type. enumerates depth first. ++generalizes 'Enum's 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:++* consistent:++    * @'cardinality' = 'length' 'enumerated'@++    so you can index the 'enumerated' with a nonnegative index below the 'cardinality'.++* distinct:++    * @(Eq a) => 'nub' 'enumerated' == 'enumerated'@++* complete:++    * @x `'elem'` 'enumerated'@++* coincides with @Bounded@ @Enum@s:++    * @('Enum' a, 'Bounded' a) => 'enumerated' == 'boundedEnumerated'@++    * @('Enum' a) => 'enumerated' == 'enumEnumerated'@++(@Bounded@ constraint elided for convenience, but relevant.)++("inputs" a type, outputs a list of values).++-}+class Enumerable a where++ enumerated :: [a]++ default enumerated :: (Generic a, GEnumerable (Rep a)) => [a]+ enumerated = to <$> genumerated++ cardinality :: proxy a -> Natural+ cardinality _ = genericLength (enumerated :: [a]) + -- overrideable for performance, but don't lie!++ -- default cardinality :: (Generic a, GEnumerable (Rep a)) => proxy a -> Natural+ -- cardinality _ = gcardinality (Proxy :: Proxy (Rep a))+ -- TODO merge both methods into one that returns their pair++{-| a (safely-)partial function. i.e. a function that:++* fails only via the 'throwM' method of 'MonadThrow' +* succeeds only via the 'return' method of 'Monad' +++-}+type Partial a b = (forall m. MonadThrow m => a -> m b)++-- | "Generic Enumerable", lifted to unary type constructors.+class GEnumerable f where+ genumerated :: [f x]+ gcardinality :: proxy f -> Natural++-- | empty list +instance GEnumerable (V1) where+ genumerated    = []+ gcardinality _ = 0+ {-# INLINE gcardinality #-}++-- | singleton list +instance GEnumerable (U1) where+ genumerated    = [U1]+ gcardinality _ = 1+ {-# INLINE gcardinality #-}++{-| call 'enumerated' ++-}+instance (Enumerable a) => GEnumerable (K1 R a) where+ genumerated    = K1 <$> enumerated+ gcardinality _ = cardinality (Proxy :: Proxy a)+ {-# INLINE gcardinality #-}++-- | multiply lists with @concatMap@+instance (GEnumerable (f), GEnumerable (g)) => GEnumerable (f :*: g) where+ genumerated    = (:*:) <$> genumerated <*> genumerated+ gcardinality _ = gcardinality (Proxy :: Proxy (f)) * gcardinality (Proxy :: Proxy (g))+ {-# INLINE gcardinality #-}+ +-- | add lists with @(<>)@+instance (GEnumerable (f), GEnumerable (g)) => GEnumerable (f :+: g) where+ genumerated    = map L1 genumerated ++ map R1 genumerated + gcardinality _ = gcardinality (Proxy :: Proxy (f)) + gcardinality (Proxy :: Proxy (g))+ {-# INLINE gcardinality #-}++-- | ignore selector metadata+instance (GEnumerable (f)) => GEnumerable (M1 S t f) where+ genumerated    = M1 <$> genumerated+ gcardinality _ = gcardinality (Proxy :: Proxy (f))+ {-# INLINE gcardinality #-}++-- | ignore constructor metadata+instance (GEnumerable (f)) => GEnumerable (M1 C t f) where+ genumerated    = M1 <$> genumerated+ gcardinality _ = gcardinality (Proxy :: Proxy (f))+ {-# INLINE gcardinality #-}++-- | ignore datatype metadata+instance (GEnumerable (f)) => GEnumerable (M1 D t f) where+ genumerated    = M1 <$> genumerated+ gcardinality _ = gcardinality (Proxy :: Proxy (f))+ {-# INLINE gcardinality #-}++{-| see "Data.Enumerate.Reify.getJectivityM"++-}+data Jectivity = Injective | Surjective | Bijective deriving (Show,Read,Eq,Ord,Enum,Bounded)++{-| wrap any @(Bounded a, Enum a)@ to be a @Enumerable@ via 'boundedEnumerated'. ++(avoids @OverlappingInstances@).    ++-}+newtype WrappedBoundedEnum a = WrappedBoundedEnum { unwrapBoundedEnum :: a } ++instance (Bounded a, Enum a) => Enumerable (WrappedBoundedEnum a) where + enumerated    = WrappedBoundedEnum <$> boundedEnumerated+ cardinality _ = boundedCardinality (Proxy :: Proxy a)++-- base types +instance Enumerable Void+instance Enumerable ()+instance Enumerable Bool+instance Enumerable Ordering++{- | ++>>> (maxBound::Int8) - (minBound::Int8)+256++-}+instance Enumerable Int8  where enumerated = boundedEnumerated; cardinality = boundedCardinality +instance Enumerable Word8 where enumerated = boundedEnumerated; cardinality = boundedCardinality +{- | ++>>> (maxBound::Int16) - (minBound::Int16) +65535++-}+instance Enumerable Int16  where enumerated = boundedEnumerated; cardinality = boundedCardinality +instance Enumerable Word16 where enumerated = boundedEnumerated; cardinality = boundedCardinality +{- | there are only a million (1,114,112) characters.  ++>>> ord minBound+0++>>> ord maxBound+1114111++>>> length [chr 0..]+1114112++-}+instance Enumerable Char where enumerated = boundedEnumerated; cardinality = boundedCardinality ++{-| the sum type. ++the 'cardinality' is the sum of the cardinalities of @a@ and @b@. ++-}+instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where + enumerated    = (Left <$> enumerated) ++ (Right <$> enumerated) + cardinality _ = cardinality (Proxy :: Proxy a) + cardinality (Proxy :: Proxy b)+instance (Enumerable a) => Enumerable (Maybe a) where + enumerated    = Nothing : (Just <$> enumerated)+ cardinality _ = 1 + cardinality (Proxy :: Proxy a)++{-| the product type. ++the 'cardinality' is the product of the cardinalities of @a@ and @b@. ++-}+instance (Enumerable a, Enumerable b) => Enumerable (a, b) where + enumerated    = (,) <$> enumerated <*> enumerated+ cardinality _ = cardinality (Proxy :: Proxy a) * cardinality (Proxy :: Proxy b)++instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a, b, c)+instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d) => Enumerable (a, b, c, d)+instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e) => Enumerable (a, b, c, d, e)+instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable f) => Enumerable (a, b, c, d, e, f)+instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable f, Enumerable g) => Enumerable (a, b, c, d, e, f, g)++{-| ++the 'cardinality' is the cardinality of the 'powerSet' of @a@, i.e. @2^|a|@. +warning: it grows quickly. don't try to take the power set of 'Char'! or even 'Word8'. ++the 'cardinality' call is efficient (depending on the efficiency of the base type's call). +you should be able to safely call 'enumerateBelow', unless the arithmetic itself becomes too large. +++-}+instance (Enumerable a, Ord a) => Enumerable (Set a) where + enumerated    = (Set.toList . powerSet . Set.fromList) enumerated+ cardinality _ = 2 ^ cardinality (Proxy :: Proxy a) ++-- | (from the @modular-arithmetic@ package)+instance (Integral i, Num i, KnownNat n) => Enumerable (Mod i n) where+ enumerated    = toMod <$> [0 .. fromInteger (natVal (Proxy :: Proxy n) - 1)]+ cardinality _ = fromInteger (natVal (Proxy :: Proxy n))++{- | for non-'Generic' Bounded Enums:++@+instance Enumerable _ where+ 'enumerated' = boundedEnumerated+ 'cardinality' = 'boundedCardinality' +@++-}+boundedEnumerated :: (Bounded a, Enum a) => [a]+boundedEnumerated = enumFromTo minBound maxBound++{-| for non-'Generic' Bounded Enums. ++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 specific+18446744073709551616++@-- 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. ++-}+boundedCardinality :: forall proxy a. (Bounded a, Enum a) => proxy a -> Natural +boundedCardinality _ = fromInteger (1 + (toInteger (fromEnum (maxBound::a))) - (toInteger (fromEnum (minBound::a))))++{- | for non-'Generic' Enums:++@+instance Enumerable ... where+ 'enumerated' = enumEnumerated+@++the enum should still be bounded. + +-}+enumEnumerated :: (Enum a) => [a]+enumEnumerated = enumFrom (toEnum 0)++{- | for non-'Generic' Bounded Indexed ('Ix') types: ++@+instance Enumerable _ where+ 'enumerated' = indexedEnumerated+ 'cardinality' = 'indexedCardinality'+@++-}+indexedEnumerated :: (Bounded a, Ix a) => [a]+indexedEnumerated = range (minBound,maxBound)++{- | for non-'Generic' Bounded Indexed ('Ix') types. +-} +indexedCardinality :: forall proxy a. (Bounded a, Ix a) => proxy a -> Natural +indexedCardinality _ = int2natural (rangeSize (minBound,maxBound::a))++{-| 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. ++-}+enumerateBelow :: forall a. (Enumerable a) => Natural -> Either Natural [a] +enumerateBelow maxSize = if theSize < maxSize then Right enumerated else Left theSize + where + theSize = cardinality (Proxy :: Proxy a)++{-| enumerate only when completely evaluating the list doesn't timeout +(before the given number of microseconds).  ++>>> enumerateTimeout (2 * 10^6) :: IO (Maybe [Bool])  -- two seconds +Just [False,True]++-}+enumerateTimeout :: (Enumerable a, NFData a) => Int -> IO (Maybe [a])+enumerateTimeout maxDuration = timeout maxDuration (return$ force enumerated)+