enumerate 0.1.1 → 0.2.1
raw patch · 21 files changed
+1495/−1484 lines, 21 filesdep +doctestdep −MemoTriedep −exceptionsdep −semigroupsdep ~basedep ~deepseqdep ~ghc-prim
Dependencies added: doctest
Dependencies removed: MemoTrie, exceptions, semigroups
Dependency ranges changed: base, deepseq, ghc-prim, template-haskell
Files
- Main.hs +9/−1
- README.md +4/−0
- enumerate.cabal +75/−25
- sources/Data/Enumerate.hs +0/−27
- sources/Data/Enumerate/Enum.hs +0/−94
- sources/Data/Enumerate/Example.hs +0/−81
- sources/Data/Enumerate/Extra.hs +0/−144
- sources/Data/Enumerate/Function.hs +0/−236
- sources/Data/Enumerate/Large.hs +0/−26
- sources/Data/Enumerate/Map.hs +0/−312
- sources/Data/Enumerate/Reify.hs +0/−157
- sources/Data/Enumerate/Types.hs +0/−381
- sources/Enumerate.hs +90/−0
- sources/Enumerate/Cardinality.hs +214/−0
- sources/Enumerate/Enum.hs +94/−0
- sources/Enumerate/Example.hs +85/−0
- sources/Enumerate/Extra.hs +58/−0
- sources/Enumerate/Main.hs +8/−0
- sources/Enumerate/Orphans/Large.hs +83/−0
- sources/Enumerate/Types.hs +738/−0
- tests/DocTest.hs +37/−0
Main.hs view
@@ -1,2 +1,10 @@ {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -import Data.Enumerate.Example +import qualified Enumerate.Example +import qualified Enumerate.Main + +main = do + putStrLn "\nEnumerate.Example..." + Enumerate.Example.main + + putStrLn "\nEnumerate.Main..." + Enumerate.Main.main
README.md view
@@ -1,4 +1,8 @@ # enumerate + +[](https://hackage.haskell.org/package/enumerate) +[](http://travis-ci.org/sboosali/enumerate) + enumerate all the values in a finite type (automatically) provides (1) a typeclass for enumerating all values in a finite type,
enumerate.cabal view
@@ -2,9 +2,17 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: enumerate -version: 0.1.1 +version: 0.2.1 synopsis: enumerate all the values in a finite type (automatically) -description: provides (1) a typeclass for enumerating all values in a finite type, (2) a generic instance for automatic deriving, and (3) helpers that reify functions (partial or total, monadic or pure) into a Map. +description: + provides + . + * (1) a typeclass for enumerating all values in a finite type, + * (2) a generic instance for automatic deriving, and + * (3) helpers that reify functions (partial or total, monadic or pure) + into a Map. + . + see the "Enumerable" module for extensive documentation. homepage: https://github.com/sboosali/enumerate license: MIT @@ -17,48 +25,90 @@ extra-source-files: README.md cabal-version: >=1.10 +source-repository head + type: git + location: https://github.com/sboosali/enumerate + + 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.Enumerate.Enum + Enumerate + Enumerate.Types + Enumerate.Enum + Enumerate.Cardinality + Enumerate.Orphans.Large + + Enumerate.Main + Enumerate.Example + Enumerate.Extra + + -- Enumerate.Domain -- Data.CoRec -- Data.CoRec.MemoTrie -- Data.TEnumerate build-depends: - base ==4.8.* - , containers ==0.5.* - , ghc-prim==0.4.* + base >= 4.7 && < 5 + , ghc-prim >=0.3 && < 0.5 , array ==0.5.* - - , semigroups ==0.18.* - , exceptions ==0.8.* - , MemoTrie ==0.6.* --- , spoon ==0.3.* - , deepseq ==1.4.* + , template-haskell >=2.9 + , containers ==0.5.* - , vinyl==0.5.* -- , modular-arithmetic==1.2.* - , template-haskell ==2.10.* + , vinyl==0.5.* + , deepseq >= 1.3 hs-source-dirs: sources default-language: Haskell2010 + default-extensions: AutoDeriveTypeable DeriveDataTypeable + DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable executable enumerate-example - main-is: Main.hs + main-is: Main.hs hs-source-dirs: . + default-language: Haskell2010 build-depends: - base >=4.8 && <4.9 + base , enumerate + + +-- $ stack test doctest +test-suite doctest + hs-source-dirs: tests + main-is: DocTest.hs + type: exitcode-stdio-1.0 + + default-language: Haskell2010 + ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N + + build-depends: + base + , enumerate + , doctest + --, cabal-info + +-- -- $ stack test unittest +-- test-suite unittest +-- hs-source-dirs: tests +-- main-is: UnitTest.hs +-- type: exitcode-stdio-1.0 +-- +-- default-language: Haskell2010 +-- ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N +-- +-- other-modules: +-- Enumerate.Test +-- +-- build-depends: +-- base +-- , enumerate +-- , hspec ==2.2.* +-- , QuickCheck ==2.8.* +-- , smallcheck ==1.1.* +-- -- , tasty +-- -- , tasty-quickcheck +-- -- , tasty-hunit
− sources/Data/Enumerate.hs
@@ -1,27 +0,0 @@-{-| 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. - -See the source of "Data.Enumerate.Example" for an example. - --} -module Data.Enumerate --TODO rename to Enumerable - ( module Data.Enumerate.Types - , module Data.Enumerate.Reify - -- , module Data.Enumerate.Domain - , module Data.Enumerate.Map - , module Data.Enumerate.Enum - ) where -import Data.Enumerate.Types -import Data.Enumerate.Reify --- import Data.Enumerate.Domain -import Data.Enumerate.Map -import Data.Enumerate.Enum
− sources/Data/Enumerate/Enum.hs
@@ -1,94 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-} - -{-| - -usage: - -@ -data A = ... - -instance 'Bounded' A where - minBound = 'minBound_enumerable' array_A - maxBound = 'maxBound_enumerable' array_A - -instance 'Enum' A where - toEnum = 'toEnum_enumerable' array_A - fromEnum = 'fromEnum_enumerable' table_A - --- CAF -array_A :: 'Array' Int A -array_A = 'array_enumerable' - --- CAF -table_A :: 'Map' A Int -table_A = 'table_enumerable' - --- we must pass in <https://wiki.haskell.org/Constant_applicative_form CAF>s --- (i.e. expressions that are top-level and unconstrained), --- which will be shared between all calls to minBound/maxBound/toEnum/fromEnum. --- TODO must we? -@ - ---TODO template-haskell - -(also see the source of "Data.Enumerate.Example") - --} -module Data.Enumerate.Enum - ( minBound_enumerable - , maxBound_enumerable - - , toEnum_enumerable - , fromEnum_enumerable - - , array_enumerable - , table_enumerable - ) where - -import Data.Enumerate.Types - -import Numeric.Natural -import qualified Data.Array as Array -import Data.Array (Array, (!)) -import qualified Data.Map as Map -import Data.Map (Map) - - -minBound_enumerable :: forall a. (Enumerable a) => Array Int a -> a -minBound_enumerable as = (as ! 0) --TODO safe get: (__fromJust__ "minBound") -{-# INLINE minBound_enumerable #-} - -maxBound_enumerable :: forall a. (Enumerable a) => Array Int a -> a -maxBound_enumerable as = (as ! (n-1)) --TODO safe get: (__fromJust__ "maxBound") - where n = nat2int $ cardinality ([] :: [a]) -{-# INLINE maxBound_enumerable #-} - - -toEnum_enumerable :: forall a. (Enumerable a) => Array Int a -> (Int -> a) -toEnum_enumerable as = \i -> (as ! i) -- i.e. (!) --TODO safe get: (__fromJust__ "toEnum") -{-# INLINE toEnum_enumerable #-} - -fromEnum_enumerable :: forall a. (Enumerable a, Ord a) => Map a Int -> (a -> Int) -fromEnum_enumerable as = \x -> (__fromJust__ "fromEnum") (Map.lookup x as) -{-# INLINE fromEnum_enumerable #-} - - ---TODO Nat ==> Int -array_enumerable :: forall a. (Enumerable a) => Array Int a --TODO -array_enumerable = Array.listArray (0, n - 1) enumerated --TODO is array efficient? - where n = nat2int $ cardinality ([] :: [a]) - -table_enumerable :: forall a. (Enumerable a, Ord a) => Map a Int -table_enumerable = Map.fromList (zip enumerated [0 .. n - 1]) - where n = nat2int $ cardinality ([] :: [a]) - - -__fromJust__ :: String -> Maybe a -> a -__fromJust__ name = maybe (__bug__ name) id - -__bug__ :: String -> a -__bug__ name = error (name ++ ": invalid Enumerable instance") ---TODO print typerep; add constraint, all types are Typeable - -nat2int :: Natural -> Int -nat2int = fromInteger . fromIntegral
− sources/Data/Enumerate/Example.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE LambdaCase, DeriveGeneric, DeriveAnyClass #-} -{-# LANGUAGE FlexibleInstances #-} -module Data.Enumerate.Example where -import Data.Enumerate - -import Data.Array (Array) -import Data.Map (Map) - ---import System.Environment (getArgs) -import Data.Void (Void) -import GHC.Generics (Generic) - - --- main = mainWith =<< getArgs --- --- mainWith = \case --- _ -> do - -main = do - putStrLn "" - traverse print demoEnumerated - - putStrLn "" - print $ (minBound :: Demo Bool) - print $ (maxBound :: Demo Bool) - - putStrLn "" - print $ demoEnumerated == [minBound..maxBound] - -{- | (for documentation) - -demonstrates: empty type, unit type, product type, sum type, type variable. - -with @\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\}@, the derivation is a one-liner: - -@ -data Demo a = ... deriving (Show,Generic,Enumerable) -@ - --} -data Demo a - = Demo0 Void - | Demo1 - | Demo2 Bool (Maybe Bool) - | Demo3 a - deriving (Show,Eq,Ord,Generic,Enumerable) - -{- | (for documentation) - -@demoEnumerated = enumerated@ - ->>> traverse print demoEnumerated -Demo1 -Demo2 False Nothing -Demo2 False (Just False) -Demo2 False (Just True) -Demo2 True Nothing -Demo2 True (Just False) -Demo2 True (Just True) -Demo3 False -Demo3 True - --} -demoEnumerated :: [Demo Bool] -demoEnumerated = enumerated - -instance Bounded (Demo Bool) where - minBound = minBound_enumerable array_DemoBool - maxBound = maxBound_enumerable array_DemoBool - -instance Enum (Demo Bool) where - toEnum = toEnum_enumerable array_DemoBool - fromEnum = fromEnum_enumerable table_DemoBool - --- CAF -array_DemoBool :: Array Int (Demo Bool) -array_DemoBool = array_enumerable - --- CAF -table_DemoBool :: Map (Demo Bool) Int -table_DemoBool = table_enumerable
− sources/Data/Enumerate/Extra.hs
@@ -1,144 +0,0 @@-{-# 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 - -{-| specialization -} -throw2maybe :: (forall m. MonadThrow m => a -> m b) -> (a -> Maybe b) -throw2maybe = id - -{-| specialization -} -throw2either :: (forall m. MonadThrow m => a -> m b) -> (a -> Either SomeException b) -throw2either = id - -{-| specialization -} -throw2list :: (forall m. MonadThrow m => a -> m b) -> (a -> [b]) -throw2list = id - -{-| 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
@@ -1,236 +0,0 @@-{-# 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. - -@ -instance ('Enumerable' a, Enumerable b, 'Ord' a, Ord b) => Enumerable (a -> b) where - 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 #-} - -{-| see 'mappingEnumeratedAt' -} -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) -<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) - -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
@@ -1,26 +0,0 @@-{-# 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
@@ -1,312 +0,0 @@-{-# 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 - - -isInjective :: (Enumerable a, Ord a, Ord b) => (a -> b) -> Maybe (b -> Maybe a) -isInjective f = isInjectiveM (return.f) - -{-| 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 - -isSurjective :: (Enumerable a, Enumerable b, Ord a, Ord b) => (a -> b) -> Maybe (b -> NonEmpty a) -isSurjective f = isSurjectiveM (return.f) - -{-| 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 - - -isBijective :: (Enumerable a, Enumerable b, Ord a, Ord b) => (a -> b) -> Maybe (b -> a) -isBijective f = isBijectiveM (return.f) - -{-| 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
@@ -1,157 +0,0 @@-{-# 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
@@ -1,381 +0,0 @@-{-# LANGUAGE RankNTypes, ScopedTypeVariables, DefaultSignatures, TypeOperators, FlexibleInstances, FlexibleContexts, LambdaCase, DataKinds #-} -{- | 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> - - -also provides instances for: - -* sets - -* modular integers - -* vinyl records - - -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 Data.Vinyl (Rec(..)) -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 product of cardinalities. -} -instance (Enumerable (f a), Enumerable (Rec f as)) => Enumerable (Rec f (a ': as)) where - enumerated = (:&) <$> enumerated <*> enumerated - cardinality _ = cardinality (Proxy :: Proxy (f a)) * cardinality (Proxy :: Proxy (Rec f as)) - -{-| the cardinality is 1. -} -instance Enumerable (Rec f '[]) where - enumerated = [RNil] - cardinality _ = 1 - -{-| - -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)
+ sources/Enumerate.hs view
@@ -0,0 +1,90 @@+{-| enumerate all values in a finite type. + +e.g. + +>>> :set -XDeriveGeneric +>>> :set -XDeriveAnyClass + +given: + +@ +-- an 'Enumerable' can be automatically derived, +-- even though it's a nested sum type (and thus not an 'Enum'). +data Edit = Edit Action Slice Region + deriving (Show,Read,Eq,Ord,Generic,Enumerable) + +data Action + = Select + | Copy + | Delete + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable) + +data Slice + = Whole + | Backwards + | Forwards + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable) + +data Region + = Character + | Token + | Line + deriving (Show,Read,Eq,Ord,Enum,Bounded,Generic,Enumerable) +@ + +we can enumerate every possible editing action: + +@ +> 'enumerated' :: [Edit] +Edit Select Whole Character +Edit Select Whole Token +Edit Select Whole Line +Edit Select Backwards Character +Edit Select Backwards Token +Edit Select Backwards Line +Edit Select Forwards Character +Edit Select Forwards Token +Edit Select Forwards Line +Edit Copy Whole Character +Edit Copy Whole Token +Edit Copy Whole Line +Edit Copy Backwards Character +Edit Copy Backwards Token +Edit Copy Backwards Line +Edit Copy Forwards Character +Edit Copy Forwards Token +Edit Copy Forwards Line +Edit Delete Whole Character +Edit Delete Whole Token +Edit Delete Whole Line +Edit Delete Backwards Character +Edit Delete Backwards Token +Edit Delete Backwards Line +Edit Delete Forwards Character +Edit Delete Forwards Token +Edit Delete Forwards Line +@ + +see "Enumerate.Types" for detailed documentation. + +the modules "Enumerate.Large" and "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. + +See the source of "Enumerate.Example" for an example. + +-} +module Enumerate --TODO rename to Enumerable + ( module Enumerate.Types + , module Enumerate.Cardinality + , module Enumerate.Enum + + -- , module Enumerate.Domain + ) where +import Enumerate.Types +import Enumerate.Cardinality +import Enumerate.Enum + +-- import Enumerate.Domain
+ sources/Enumerate/Cardinality.hs view
@@ -0,0 +1,214 @@+{-# LANGUAGE TypeFamilies, ExplicitNamespaces, TypeOperators, FlexibleInstances #-} +{-# LANGUAGE DataKinds, UndecidableInstances, ConstraintKinds, KindSignatures #-} +{-# LANGUAGE ScopedTypeVariables, FlexibleContexts #-} + +{-| the cardinality of a finite type, at the type-level. + +-} +module Enumerate.Cardinality where + +import GHC.Generics +import Data.Vinyl (Rec) +import Data.Proxy (Proxy) +import Data.Void (Void) +import Data.Word (Word8, Word16) +import Data.Int (Int8, Int16) +import Data.Set (Set) +import Numeric.Natural (Natural) +import GHC.TypeLits (Nat, KnownNat, natVal, type (+), type (*), type (^), type (<=?)) +import Data.Proxy (Proxy(..)) + +-- alternatives: +-- class Finite a where +-- type GenericCardinality a = GCardinality (Rep a) +-- class Cardinality a n +-- class Finite a where type Cardinality a :: Nat + {- needs DefaultTypeInstances, + or we have to pick between deriving instances (the user should) + and manually providing them (the author should, for base types like Char, + because their Generic rep is huge and slows down the compiler to a stop) + -} + -- class GFinite a where +-- default type (Generic a) => Cardinality a = GCardinality (Rep a) +-- type instance {-# OVERLAPS #-} (Generic a) => Cardinality a = GCardinality (Rep a) + +{-| a type is finite, i.e. has a bounded size. + +laws: + + * consistent with "Enumerate.Enumerable": + + * @'cardinality' = 'reifyCardinality'@ + + i.e. the value-level (a 'Natural') matches the type-level (a 'Nat') + +e.g. + +>>> reifyCardinality ([]::[Bool]) +2 + +-} +class Finite a where + type Cardinality a :: Nat + type Cardinality a = GCardinality (Rep a) + +-- base types. TODO any more? + +-- | @0@ +instance Finite Void +-- | @1@ +instance Finite () +-- | @2@ +instance Finite Bool +-- | @3@ +instance Finite Ordering + +instance Finite (Proxy a) where + type Cardinality (Proxy a) = 1 + +-- | @2^8@ +instance Finite Int8 where + type Cardinality Int8 = 256 + +-- | @2^8@ +instance Finite Word8 where + type Cardinality Word8 = 256 + +-- | @2^16@ +instance Finite Int16 where + type Cardinality Int16 = 65536 + +-- | @2^16@ +instance Finite Word16 where + type Cardinality Word16 = 65536 + +-- | @1114112@ +instance Finite Char where + type Cardinality Char = 1114112 + +-- | @1 + a@ +instance (Finite a) => Finite (Maybe a) where + type Cardinality (Maybe a) = 1 + (Cardinality a) + +-- | @a + b@ +instance (Finite a, Finite b) => Finite (Either a b) where + type Cardinality (Either a b) = (Cardinality a) + (Cardinality b) + +{-| the cardinality is a product of cardinalities. -} +instance (Finite (f a), Finite (Rec f as)) => Finite (Rec f (a ': as)) where + type Cardinality (Rec f (a ': as)) = (Cardinality (f a)) * (Cardinality (Rec f as)) + + -- | @1@ +instance Finite (Rec f '[]) where + type Cardinality (Rec f '[]) = 1 + +{- +class Finite (Mod i n) where + type Cardinality (Mod i n) = n +-} + +-- | @a*b@ +instance (Finite a, Finite b) => Finite (a, b) + +-- | @a*b*c@ +instance (Finite a, Finite b, Finite c) => Finite (a, b, c) +-- | @a*b*c*d@ +instance (Finite a, Finite b, Finite c, Finite d) => Finite (a, b, c, d) +-- | @a*b*c*d*e@ +instance (Finite a, Finite b, Finite c, Finite d, Finite e) => Finite (a, b, c, d, e) +-- | @a*b*c*d*e*f@ +instance (Finite a, Finite b, Finite c, Finite d, Finite e, Finite f) => Finite (a, b, c, d, e, f) +-- | @a*b*c*d*e*f*g@ +instance (Finite a, Finite b, Finite c, Finite d, Finite e, Finite f, Finite g) => Finite (a, b, c, d, e, f, g) + +-- | @2^a@ +instance (Finite a) => Finite (Set a) where + type Cardinality (Set a) = 2 ^ (Cardinality a) + +-- | @b^a@ +instance (Finite a, Finite b) => Finite (a -> b) where + type Cardinality (a -> b) = (Cardinality b) ^ (Cardinality a) + +-------------------------------------------------------------------------------- + +type family GCardinality (f :: * -> *) :: Nat + +type instance GCardinality (V1) = 0 + +type instance GCardinality (U1) = 1 + +type instance GCardinality (K1 i a) = Cardinality a + +type instance GCardinality (f :+: g) = (GCardinality f) + (GCardinality g) + +type instance GCardinality (f :*: g) = (GCardinality f) * (GCardinality g) + +type instance GCardinality (M1 i t f) = GCardinality f + +-------------------------------------------------------------------------------- + +{-| + +>>> reifyCardinality ([]::[Bool]) +2 + +-} +reifyCardinality + :: forall a proxy. (KnownNat (Cardinality a)) + => proxy a + -> Natural +reifyCardinality _ = fromInteger (natVal (Proxy::Proxy (Cardinality a))) + + +{-| typechecks only when the constraint is satisifed. + +a constaint. + +-} +type CardinalityWithin n a = IsCardinalityWithin n a ~ True + +{-| + +a predicate, inclusive. + +@ +> type CardinalityWithinAMillion a = CardinalityWithin 1000000 a +> :kind! CardinalityWithinAMillion Bool +True +> :kind! CardinalityWithinAMillion Char +False +@ + +-} +type IsCardinalityWithin n a = Cardinality a <=? n + +{- +>>> :set -XDataKinds +>>> :set -XConstraintKinds +>>> :set -XTypeFamilies +>>> type CardinalityWithinAMillion a = CardinalityWithin 1000000 a +>>> :kind! CardinalityWithinAMillion Bool +True +>>> :kind! CardinalityWithinAMillion Char +False +-} + +-- {-| enumerate only when the cardinality is small enough. +-- +-- >>> enumerateWithin 2 :: Either Natural [Bool] +-- Left 2 +-- +-- >>> enumerateWithin 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. +-- +-- -} +-- enumerateWithin :: forall a. (Enumerable a) => Natural -> Either Natural [a] --TODO move +-- enumerateWithin maxSize = if theSize < maxSize +-- then Right enumerated +-- else Left theSize +-- where +-- theSize = cardinality (Proxy :: Proxy a)
+ sources/Enumerate/Enum.hs view
@@ -0,0 +1,94 @@+{-# LANGUAGE ScopedTypeVariables #-} + +{-| + +usage: + +@ +data A = ... + +instance 'Bounded' A where + minBound = 'minBound_enumerable' array_A + maxBound = 'maxBound_enumerable' array_A + +instance 'Enum' A where + toEnum = 'toEnum_enumerable' array_A + fromEnum = 'fromEnum_enumerable' table_A + +-- CAF +array_A :: 'Array' Int A +array_A = 'array_enumerable' + +-- CAF +table_A :: 'Map' A Int +table_A = 'table_enumerable' + +-- we must pass in <https://wiki.haskell.org/Constant_applicative_form CAF>s +-- (i.e. expressions that are top-level and unconstrained), +-- which will be shared between all calls to minBound/maxBound/toEnum/fromEnum. +-- TODO must we? +@ + +--TODO template-haskell + +(also see the source of "Enumerate.Example") + +-} +module Enumerate.Enum + ( minBound_enumerable + , maxBound_enumerable + + , toEnum_enumerable + , fromEnum_enumerable + + , array_enumerable + , table_enumerable + ) where + +import Enumerate.Types + +import Numeric.Natural +import qualified Data.Array as Array --IntMap +import Data.Array (Array, (!)) +import qualified Data.Map as Map +import Data.Map (Map) + + +minBound_enumerable :: forall a. (Enumerable a) => Array Int a -> a +minBound_enumerable as = (as ! 0) --TODO safe get: (__fromJust__ "minBound") +{-# INLINE minBound_enumerable #-} + +maxBound_enumerable :: forall a. (Enumerable a) => Array Int a -> a +maxBound_enumerable as = (as ! (n-1)) --TODO safe get: (__fromJust__ "maxBound") + where n = nat2int $ cardinality ([] :: [a]) +{-# INLINE maxBound_enumerable #-} + + +toEnum_enumerable :: forall a. (Enumerable a) => Array Int a -> (Int -> a) +toEnum_enumerable as = \i -> (as ! i) -- i.e. (!) --TODO safe get: (__fromJust__ "toEnum") +{-# INLINE toEnum_enumerable #-} + +fromEnum_enumerable :: forall a. (Enumerable a, Ord a) => Map a Int -> (a -> Int) +fromEnum_enumerable as = \x -> (__fromJust__ "fromEnum") (Map.lookup x as) +{-# INLINE fromEnum_enumerable #-} + + +--TODO Nat ==> Int +array_enumerable :: forall a. (Enumerable a) => Array Int a --TODO +array_enumerable = Array.listArray (0, n - 1) enumerated --TODO is array efficient? + where n = nat2int $ cardinality ([] :: [a]) + +table_enumerable :: forall a. (Enumerable a, Ord a) => Map a Int +table_enumerable = Map.fromList (zip enumerated [0 .. n - 1]) + where n = nat2int $ cardinality ([] :: [a]) + + +__fromJust__ :: String -> Maybe a -> a +__fromJust__ name = maybe (__bug__ name) id + +__bug__ :: String -> a +__bug__ name = error (name ++ ": invalid Enumerable instance") +--TODO print typerep; add constraint, all types are Typeable + +nat2int :: Natural -> Int +nat2int = fromInteger . fromIntegral
+ sources/Enumerate/Example.hs view
@@ -0,0 +1,85 @@+{-# LANGUAGE LambdaCase, DeriveGeneric, DeriveAnyClass #-} +{-# LANGUAGE FlexibleInstances #-} +{- + +-} +module Enumerate.Example where +import Enumerate +import Enumerate.Extra + +import Data.Array (Array) +import Data.Map (Map) + +--import System.Environment (getArgs) +import Data.Void (Void) +import GHC.Generics (Generic) + + +-- main = mainWith =<< getArgs +-- +-- mainWith = \case +-- _ -> do + +main = do + putStrLn "" + traverse print demoEnumerated + + putStrLn "" + print $ (minBound :: Demo Bool) + print $ (maxBound :: Demo Bool) + + putStrLn "" + print $ demoEnumerated == [minBound..maxBound] + +{- | (for documentation) + +demonstrates: empty type, unit type, product type, sum type, type variable. + +with @\{\-\# LANGUAGE DeriveGeneric, DeriveAnyClass \#\-\}@, the derivation is a one-liner: + +@ +data Demo a = ... deriving (Show,Generic,Enumerable) +@ + +-} +data Demo a + = Demo0 Void + | Demo1 + | Demo2 Bool (Maybe Bool) + | Demo3 a + deriving (Show,Eq,Ord,Generic,Enumerable) + +{- | (for documentation) + +@demoEnumerated = enumerated@ + +>>> traverse_ print demoEnumerated +Demo1 +Demo2 False Nothing +Demo2 False (Just False) +Demo2 False (Just True) +Demo2 True Nothing +Demo2 True (Just False) +Demo2 True (Just True) +Demo3 False +Demo3 True + +-} +demoEnumerated :: [Demo Bool] +demoEnumerated = enumerated + +instance Bounded (Demo Bool) where + minBound = minBound_enumerable array_DemoBool + maxBound = maxBound_enumerable array_DemoBool + +instance Enum (Demo Bool) where + toEnum = toEnum_enumerable array_DemoBool + fromEnum = fromEnum_enumerable table_DemoBool + +-- CAF +array_DemoBool :: Array Int (Demo Bool) +array_DemoBool = array_enumerable + +-- CAF +table_DemoBool :: Map (Demo Bool) Int +table_DemoBool = table_enumerable
+ sources/Enumerate/Extra.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE LambdaCase, ScopedTypeVariables #-} +{-| + +-} +module Enumerate.Extra + ( module Enumerate.Extra + , (>>>), traverse_ + ) where + +-- import Language.Haskell.TH.Syntax (Name,nameBase) +import Control.Arrow ((&&&), (>>>)) +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 + + +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) --TODO use [[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) + +{-| (for doctest) +-} +printMappings :: (Show a) => [[a]] -> IO () +printMappings mappings = traverse_ (\mapping -> (putStrLn"") >> (traverse print) mapping) mappings >> return()
+ sources/Enumerate/Main.hs view
@@ -0,0 +1,8 @@+module Enumerate.Main where +import Enumerate + +main = do + putStrLn "\nreifyCardinality @Bool..." + print $ reifyCardinality [False] + + putStrLn "\n"
+ sources/Enumerate/Orphans/Large.hs view
@@ -0,0 +1,83 @@+{-# LANGUAGE TypeFamilies, ExplicitNamespaces, DataKinds, UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-| orphan instances, of 'Enumerable', for large types +(i.e. 'Word32' \/ 'Word64' \/ 'Int32' \/ 'Int64'). + +see: + +* 'boundedEnumerated', 'boundedCardinality' + +(that are included for completeness, but not exported by default +(i.e. by "Enumerate"). +you probably want build-time instance-resolution errors instead of +probable runtime non-termination). + +-} +module Enumerate.Orphans.Large where +import Enumerate.Types + +import Data.Word (Word32, Word64) +import Data.Int (Int32, Int64) +-- import GHC.TypeLits (Nat, type (^)) + + +{- | finite but too large. @2^64@ is a few billion. + +>>> 1 + toInteger (maxBound::Int32) - toInteger (minBound::Int32) +4294967296 + +-} +instance Enumerable Int32 where + -- type Cardinality Int32 = 4294967296 -- 2^32 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Word32 where + -- type Cardinality Word32 = 4294967296 -- 2^32 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +{-| finite but too large. @2^64@ is over a billion billion. + +e.g. 'Enumerate.reifyFunction' (which takes time linear in the domain) +on a function of type @(:: Int -> Bool)@, +won't terminate anytime soon. + +>>> 1 + toInteger (maxBound::Int64) - toInteger (minBound::Int64) +18446744000000000000 + +-} +instance Enumerable Int64 where + -- type Cardinality Int64 = 18446744000000000000 -- 2^64 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Word64 where + -- type Cardinality Word64 = 18446744000000000000 -- 2^64 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +{-| finite but too large. + +>>> 1 + toInteger (maxBound::Int) - toInteger (minBound::Int) +... + +-} +instance Enumerable Int where + -- type Cardinality Int = INT_SIZE + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Word where + -- type Cardinality Word = INT_SIZE -- ^ "A Word is an unsigned integral type, with the same size as Int." + enumerated = boundedEnumerated + cardinality = boundedCardinality + +-- {-| size is platform-specific, often 2^32 or 2^64. +-- +-- see <> +-- +-- TODO find real size +-- +-- -} +-- type INT_SIZE = 18446744000000000000
+ sources/Enumerate/Types.hs view
@@ -0,0 +1,738 @@+{-# LANGUAGE RankNTypes, ScopedTypeVariables, DefaultSignatures, TypeOperators #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts, LambdaCase #-} +{-# LANGUAGE TypeFamilies, ExplicitNamespaces, DataKinds, UndecidableInstances #-} + +{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-} + +{- | enumerate all values in a finite type. + +see the 'Enumerable' class for documentation. + +see "Enumerate.Example" for examples. + +can also help automatically derive @<https://hackage.haskell.org/package/QuickCheck/docs/Test-QuickCheck-Arbitrary.html QuickCheck>@ instances: + +@ +newtype ValidString = ValidString String + deriving (Show) +validStrings :: [String] +makeValidString :: String -> Maybe ValidString +makeValidString s = if s `member` validStrings then Just (ValidString s) else Nothing +instance 'Enumerable' ValidString where enumerated = ValidString <$> validStrings ... -- manually (since normal String's are infinite) +instance <https://hackage.haskell.org/package/QuickCheck/docs/Test-QuickCheck.html#t:Arbitrary Arbitrary> ValidString where arbitrary = elements 'enumerated' + +data ValidName = ValidName ValidString ValidString | CoolValidName [ValidString] + deriving (Show,Generic) +instance 'Enumerable' ValidName -- automatically + +instance Arbitrary ValidName where arbitrary = elements 'enumerated' +@ + +Provides instances for all base types (whenever possible): + +* under @Data.@ \/ @Control.@ \/ @System.@ \/ @Text.@, and even @GHC.@ +* even non-'Enum's +* except when too large (like 'Int') (see "Enumerate.Large") + +background on @Generics@: + +* <https://hackage.haskell.org/package/base-4.8.1.0/docs/GHC-Generics.html GHC.Generics> + +also provides instances for: + +* sets + +* vinyl records + +related packages: + +* <http://hackage.haskell.org/package/enumerable enumerable>. +no @Generic@ instance. + +* <http://hackage.haskell.org/package/universe universe> +no @Generic@ instance. + +* <http://hackage.haskell.org/package/prelude-safeenum-0.1.1.2/docs/Prelude-SafeEnum.html SafeEnum> +only @Enum@s + +* <http://hackage.haskell.org/package/emgm-0.4/docs/Generics-EMGM-Functions-Enum.html emgm>. + allows infinite lists (by convention). too heavyweight. + +* <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 Enumerate.Types where +import Enumerate.Extra + +import Data.Vinyl (Rec(..)) +import Control.DeepSeq (NFData,force) + +import qualified Data.Set as Set +import Data.Set (Set) +import GHC.Generics +import Data.Data (Data) +import Control.Arrow ((&&&)) +import Data.List (genericLength) +import System.Timeout (timeout) +import Numeric.Natural (Natural) +import Data.Ix (Ix(..)) +-- import GHC.TypeLits (Nat, KnownNat, natVal, type (+), type (*), type (^)) + +import Data.Void (Void) +import Data.Word (Word8, Word16) +import Data.Int (Int8, Int16) +import Data.Proxy (Proxy(..)) + +-- for instances... +import Data.Typeable ((:~:)(..)) +import Control.Applicative (Const(..)) +import Data.Functor.Identity (Identity(..)) +import Data.Type.Coercion (Coercion(..)) +import Data.Coerce (Coercible) +import Data.Char (GeneralCategory) +import Data.Ratio (Ratio,(%)) +import Data.Complex (Complex(..)) +-- +import Control.Exception (ArithException(..),AsyncException(..),NonTermination(..),NestedAtomically(..),BlockedIndefinitelyOnMVar(..),BlockedIndefinitelyOnSTM(..),AllocationLimitExceeded(..),Deadlock(..)) +import Data.Monoid (Any,All,Dual,First,Last,Sum,Product,Alt,Endo) +import System.IO (IOMode,SeekMode,Newline(..),NewlineMode(NewlineMode)) +import Text.Printf (FormatAdjustment(..),FormatSign(..)) +import Foreign.C (CChar,CWchar,CSChar,CUChar,CShort,CUShort) +import System.Posix.Types (CIno,CMode) +import GHC.Exts(Down(..),SpecConstrAnnotation(..)) +-- +-- TODO CCc +import GHC.Conc.Windows (ConsoleEvent) +import GHC.IO.Buffer (BufferState(..)) +import GHC.IO.Device (IODeviceType(..)) +import GHC.IO.Encoding.Failure (CodingFailureMode(..)) +import GHC.IO.Encoding.Types (CodingProgress(..)) +import GHC.RTS.Flags (DoTrace,DoHeapProfile,DoCostCentres,GiveGCStats) + +--import Data.Modular (not on stack) +-- * modular integers + + +{- | 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: + +* finite: + + * @'cardinality' /= _|_@ + +* 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 + +{- +instance Enumerable where + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable where + enumerated = [] + +instance (Enumerable a) => Enumerable (X a) where + enumerated = X <$> enumerated + +-} + +{-| wrap any @(Bounded a, Enum a)@ to be a @Enumerable@ via 'boundedEnumerated'. + +(avoids @OverlappingInstances@). + +-} +newtype WrappedBoundedEnum a = WrappedBoundedEnum { unwrapBoundedEnum :: a } + +-------------------------------------------------------------------------------- + -- main base types + +{- NOTE: to declare instances: + +* use default, when Generic (easiest) +* use boundedEnumerated/boundedCardinality, when only Bounded (faster and safer than enumEnumerated) +* use enumEnumerated, when only Enum (doesn't import constructors, only type) +* use constructors, when no relevant instances + +-} + +--NOTE this file takes ~1s to build. split into another with orphans? + +instance Enumerable Void +instance Enumerable () +instance Enumerable Bool +instance Enumerable Ordering + +-- | (phantom in @a@) +instance Enumerable (Proxy a) + +instance (Enumerable a) => Enumerable (Identity a) where + enumerated = Identity <$> enumerated + +instance (Enumerable a) => Enumerable (Const a b) where + enumerated = Const <$> enumerated + +instance (a ~ b) => Enumerable (a :~: b) where + enumerated = [Refl] + +instance (Coercible a b) => Enumerable (Coercion a b) where + enumerated = [Coercion] + +-- Enumerable TypeRep -- we can't list all known types, statically (because separate compilation). +-- but dynamically, maybe? and probably constant throughout the running program i.e. still pure. + +{- | + +@-- ('toInteger' prevents overflow)@ + +>>> 1 + toInteger (maxBound::Int8) - toInteger (minBound::Int8) +256 + +-} +instance Enumerable Int8 where + -- type Cardinality Int8 = 256 -- 2^8 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Word8 where + -- type Cardinality Word8 = 256 -- 2^8 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +{- | + +>>> 1 + toInteger (maxBound::Int16) - toInteger (minBound::Int16) +65536 + +-} +instance Enumerable Int16 where + -- type Cardinality Int16 = 65536 -- 2^16 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Word16 where + -- type Cardinality Word16 = 65536 -- 2^16 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +{- | there are only a million (1,114,112) characters. + +>>> import Data.Char (ord,chr) -- 'ord', 'chr' + +>>> ord minBound +0 + +>>> ord maxBound +1114111 + +>>> length [chr 0 ..] +1114112 + +-} +instance Enumerable Char where + -- type Cardinality Char = 1114112 + enumerated = boundedEnumerated + cardinality = boundedCardinality + +{-| the sum type. + +the 'cardinality' is the sum of the cardinalities of @a@ and @b@. + +>>> cardinality ([] :: [Either Bool Ordering]) +5 + +-} +instance (Enumerable a, Enumerable b) => Enumerable (Either a b) where + -- type Cardinality (Either a b) = (Cardinality a) + (Cardinality b) + enumerated = (Left <$> enumerated) ++ (Right <$> enumerated) + cardinality _ = cardinality (Proxy :: Proxy a) + cardinality (Proxy :: Proxy b) + +{-| -} +instance (Enumerable a) => Enumerable (Maybe a) where + -- type Cardinality (Maybe a) = 1 + (Cardinality a) + 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@. + +>>> cardinality ([] :: [(Bool,Ordering)]) +6 + +-} +instance (Enumerable a, Enumerable b) => Enumerable (a, b) --where + -- enumerated = (,) <$> enumerated <*> enumerated + -- cardinality _ = cardinality (Proxy :: Proxy a) * cardinality (Proxy :: Proxy b) + +-- | 3 +instance (Enumerable a, Enumerable b, Enumerable c) => Enumerable (a, b, c) +-- | 4 +instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d) => Enumerable (a, b, c, d) +-- | 5 +instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e) => Enumerable (a, b, c, d, e) +-- | 6 +instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable f) => Enumerable (a, b, c, d, e, f) +-- | 7 +instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable f, Enumerable g) => Enumerable (a, b, c, d, e, f, g) + +-- instance (Enumerable a, Enumerable b, Enumerable c, Enumerable d, Enumerable e, Enumerable f, Enumerable g, Enumerable h) => Enumerable (a, b, c, d, e, f, g, h) +{- +Could not deduce (Generic (a, b, c, d, e, f, g, h)) + arising from a use of `Enumerate.Types.$gdmenumerated' +-} + +{-| + +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. + +>>> enumerated :: [Set Bool] +[fromList [],fromList [False],fromList [False,True],fromList [True]] + +-} +instance (Enumerable a, Ord a) => Enumerable (Set a) where + -- type Cardinality (Set a) = 2 ^ (Cardinality a) + enumerated = (Set.toList . powerSet . Set.fromList) enumerated + cardinality _ = 2 ^ cardinality (Proxy :: Proxy a) + +-------------------------------------------------------------------------------- +-- more base types + +instance Enumerable GeneralCategory where + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable IOMode where + enumerated = enumEnumerated + -- enumerated = [ReadMode,WriteMode,AppendMode,ReadWriteMode] + -- enumerated = boundedEnumerated + -- cardinality = boundedCardinality + +instance Enumerable SeekMode where + enumerated = enumEnumerated + -- enumerated = [AbsoluteSeek,RelativeSeek,SeekFromEnd] + -- enumerated = boundedEnumerated + -- cardinality = boundedCardinality + +instance Enumerable ArithException where + enumerated = + [ Overflow + , Underflow + , LossOfPrecision + , DivideByZero + , Denormal + , RatioZeroDenominator + ] + +instance Enumerable AsyncException where + enumerated = [StackOverflow, HeapOverflow, ThreadKilled, UserInterrupt] + +instance Enumerable NonTermination where + enumerated = [NonTermination] + +instance Enumerable NestedAtomically where + enumerated = [NestedAtomically] + +instance Enumerable BlockedIndefinitelyOnMVar where + enumerated = [BlockedIndefinitelyOnMVar] + +instance Enumerable BlockedIndefinitelyOnSTM where + enumerated = [BlockedIndefinitelyOnSTM] + +instance Enumerable AllocationLimitExceeded where + enumerated = [AllocationLimitExceeded] + +instance Enumerable Deadlock where + enumerated = [Deadlock] + +instance Enumerable Newline where + enumerated = [LF,CRLF] + +instance Enumerable NewlineMode where + enumerated = NewlineMode <$> enumerated <*> enumerated + +instance Enumerable FormatAdjustment where + enumerated = [LeftAdjust,ZeroPad] + +instance Enumerable FormatSign where + enumerated = [SignPlus,SignSpace] + +-- instance Enumerable CCc where +-- enumerated = boundedEnumerated +-- cardinality = boundedCardinality + +instance Enumerable All +instance Enumerable Any +instance (Enumerable a) => Enumerable (Dual a) +instance (Enumerable a) => Enumerable (First a) +instance (Enumerable a) => Enumerable (Last a) +instance (Enumerable a) => Enumerable (Sum a) +instance (Enumerable a) => Enumerable (Product a) +instance (Enumerable (a -> a)) => Enumerable (Endo a) +instance (Enumerable (f a)) => Enumerable (Alt f a) + +instance (Enumerable a) => Enumerable (Complex a) where + enumerated = (:+) <$> enumerated <*> enumerated + +{-| (@a@ can be any @Enumerable@, +unlike the @Enum@ instance where @a@ is an @Integral@). +-} +-- instance (Enumerable a) => Enumerable (Ratio a) where +-- enumerated = (%) <$> enumerated <*> enumerated + +-------------------------------------------------------------------------------- +-- ghc-only + +instance (Enumerable a) => Enumerable (Down a) where + enumerated = Down <$> enumerated + +instance Enumerable CIno where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CMode where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CChar where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CWchar where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CSChar where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CUChar where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CShort where + enumerated = boundedEnumerated + cardinality = boundedCardinality +instance Enumerable CUShort where + enumerated = boundedEnumerated + cardinality = boundedCardinality + +instance Enumerable Associativity + -- LeftAssociative,RightAssociative,NotAssociative + +instance Enumerable SpecConstrAnnotation where + enumerated = [NoSpecConstr,ForceSpecConstr] + +instance Enumerable ConsoleEvent where + enumerated = enumEnumerated + +instance Enumerable BufferState where + enumerated = [ReadBuffer,WriteBuffer] + +instance Enumerable IODeviceType where + enumerated = [Directory,Stream,RegularFile,RawDevice] + +instance Enumerable CodingFailureMode where + enumerated = [ErrorOnCodingFailure,IgnoreCodingFailure,TransliterateCodingFailure,RoundtripFailure] + +instance Enumerable CodingProgress where + enumerated = [InputUnderflow,OutputUnderflow,InvalidSequence] + +instance Enumerable DoTrace where + enumerated = enumEnumerated +instance Enumerable DoHeapProfile where + enumerated = enumEnumerated +instance Enumerable DoCostCentres where + enumerated = enumEnumerated +instance Enumerable GiveGCStats where + enumerated = enumEnumerated + +{- TODO why not generic/enum/bounded? ghc build time? to avoid recursive imports? + +nothing: +ArithException +AsyncException +NonTermination +NestedAtomically +BlockedIndefinitelyOnMVar +BlockedIndefinitelyOnSTM +AllocationLimitExceeded +Deadlock +Fixity +FormatAdjustment +FormatSign +Newline +CCc +CChar +CWChar +CSChar +CUChar +CShort +CUShort + +no generic: +NewlineMode +Ratio + +no bounded: +IOMode +SeekMode +ConsoleEvent +DoTrace +DoHeapProfile +DoCostCentres +GiveGCStats + +-} + +-------------------------------------------------------------------------------- +-- package types + +instance (Bounded a, Enum a) => Enumerable (WrappedBoundedEnum a) where + -- type Cardinality (WrappedBoundedEnum a) = Cardinality a + enumerated = WrappedBoundedEnum <$> boundedEnumerated + cardinality _ = boundedCardinality (Proxy :: Proxy a) + +-------------------------------------------------------------------------------- +-- dependency types + +{-| the cardinality is a product of cardinalities. -} +instance (Enumerable (f a), Enumerable (Rec f as)) => Enumerable (Rec f (a ': as)) where + -- type Cardinality (Rec f (a ': as)) = (Cardinality (f a)) * (Cardinality (Rec f as)) + enumerated = (:&) <$> enumerated <*> enumerated + cardinality _ = cardinality (Proxy :: Proxy (f a)) * cardinality (Proxy :: Proxy (Rec f as)) + +{-| -} +instance Enumerable (Rec f '[]) where + -- type Cardinality (Rec f '[]) = 1 + enumerated = [RNil] + cardinality _ = 1 + +{- +-- | (from the @modular-arithmetic@ package) +instance (Integral i, Num i, KnownNat n) => Enumerable (Mod i n) where + -- type Cardinality (Mod i n) = n + enumerated = toMod <$> [0 .. fromInteger (natVal (Proxy :: Proxy n) - 1)] + cardinality _ = fromInteger (natVal (Proxy :: Proxy n)) +-} + +-------------------------------------------------------------------------------- + +-- | "Generic Enumerable", lifted to unary type constructors. +class GEnumerable f where +-- class (KnownNat (GCardinality f)) => GEnumerable f where + -- type GCardinality f :: Nat + genumerated :: [f x] + gcardinality :: proxy f -> Natural + +-- | empty list +instance GEnumerable (V1) where + -- type GCardinality (V1) = 0 + genumerated = [] + gcardinality _ = 0 + {-# INLINE gcardinality #-} + +-- | singleton list +instance GEnumerable (U1) where + -- type GCardinality (U1) = 1 + genumerated = [U1] + gcardinality _ = 1 + {-# INLINE gcardinality #-} + +{-| call 'enumerated' + +-} +instance (Enumerable a) => GEnumerable (K1 R a) where + -- type GCardinality (K1 R a) = Cardinality a + genumerated = K1 <$> enumerated + gcardinality _ = cardinality (Proxy :: Proxy a) + {-# INLINE gcardinality #-} + +-- | multiply lists with @concatMap@ +instance (GEnumerable (f), GEnumerable (g)) => GEnumerable (f :*: g) where + -- type GCardinality (f :*: g) = (GCardinality f) * (GCardinality g) + 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 + -- type GCardinality (f :+: g) = (GCardinality f) + (GCardinality g) + 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 + -- type GCardinality (M1 S t f) = GCardinality f + genumerated = M1 <$> genumerated + gcardinality _ = gcardinality (Proxy :: Proxy (f)) + {-# INLINE gcardinality #-} + +-- | ignore constructor metadata +instance (GEnumerable (f)) => GEnumerable (M1 C t f) where + -- type GCardinality (M1 C t f) = GCardinality f + genumerated = M1 <$> genumerated + gcardinality _ = gcardinality (Proxy :: Proxy (f)) + {-# INLINE gcardinality #-} + +-- | ignore datatype metadata +instance (GEnumerable (f)) => GEnumerable (M1 D t f) where + -- type GCardinality (M1 D t f) = GCardinality f + genumerated = M1 <$> genumerated + gcardinality _ = gcardinality (Proxy :: Proxy (f)) + {-# INLINE gcardinality #-} + +-------------------------------------------------------------------------------- + +{- | 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. + +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 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] --TODO move +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]) --TODO move +enumerateTimeout maxDuration + = timeout maxDuration (return$ force enumerated)
+ tests/DocTest.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{- + +(the + +>>> print "Data.Enumerate._..." + +are for debugging.) + +-} +import Test.DocTest +-- import Data.Enumerate.Extra + +-- import Cabal.Info (getLibraryModules) +-- +-- doctestLibraryModules = do +-- ms <- getLibraryModules >>= either (show >>> error) return +-- traverse_ print ms +-- doctest ms + + +main = do + -- doctestLibraryModules + + doctest + [ "sources/Enumerate.hs" + , "sources/Enumerate/Types.hs" + , "sources/Enumerate/Extra.hs" + ] + + doctest + [ "sources/Enumerate/Example.hs" + ] + + doctest + [ "sources/Enumerate/Cardinality.hs" + ]