diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,20 +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. +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. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,2 +1,2 @@ -{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -import Data.Enumerate.Example +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +import Data.Enumerate.Example diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,6 +1,25 @@ -# enumerate -enumerate all the values in a finite type (automatically) - -## (extensive) documentation -https://hackage.haskell.org/package/enumerate - +# enumerate +enumerate all the values in a finite type (automatically) + +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. + +# example + +```haskell + {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} + import Data.Enumerable (Enumerable(..)) + import Data.Generics (Generics) + + data CrudOp = Add | Edit | Delete | View + deriving (Eq,Ord,Enum,Bounded,Generic,Enumerable) + data Route = Home | Person CrudOp | House CrudOp + deriving (Eq,Ord,Generic,Enumerable) + + >>> enumerated :: [Route] + [Home, Person Add, Person Edit, Person Delete, Person View, House Add, House Edit, House Delete, House View] +``` + +# (extensive) documentation: +https://hackage.haskell.org/package/enumerate diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/enumerate.cabal b/enumerate.cabal --- a/enumerate.cabal +++ b/enumerate.cabal @@ -1,66 +1,63 @@ --- 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 - +-- Initial enumerate.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: enumerate +version: 0.1.0 +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. + +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 + + +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 + -- Data.TEnumerate + + build-depends: + base ==4.8.* + , containers ==0.5.* + , ghc-prim==0.4.* + + , semigroups ==0.18.* + , 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 diff --git a/sources/Data/Enumerate.hs b/sources/Data/Enumerate.hs --- a/sources/Data/Enumerate.hs +++ b/sources/Data/Enumerate.hs @@ -1,23 +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 +{-| 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 diff --git a/sources/Data/Enumerate/Domain.hs b/sources/Data/Enumerate/Domain.hs deleted file mode 100644 --- a/sources/Data/Enumerate/Domain.hs +++ /dev/null @@ -1,109 +0,0 @@ -{-# 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 = - diff --git a/sources/Data/Enumerate/Example.hs b/sources/Data/Enumerate/Example.hs --- a/sources/Data/Enumerate/Example.hs +++ b/sources/Data/Enumerate/Example.hs @@ -1,52 +1,51 @@ -{-# 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 - +{-# 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 + _ -> traverse print demoEnumerated + + +{- | (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 diff --git a/sources/Data/Enumerate/Extra.hs b/sources/Data/Enumerate/Extra.hs --- a/sources/Data/Enumerate/Extra.hs +++ b/sources/Data/Enumerate/Extra.hs @@ -1,132 +1,144 @@ -{-# 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 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) - +{-# 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 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) + diff --git a/sources/Data/Enumerate/Function.hs b/sources/Data/Enumerate/Function.hs --- a/sources/Data/Enumerate/Function.hs +++ b/sources/Data/Enumerate/Function.hs @@ -1,231 +1,236 @@ -{-# 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 - -(LT,False) -(EQ,False) -(GT,False) - -(LT,False) -(EQ,False) -(GT,True) - -(LT,False) -(EQ,True) -(GT,False) - -(LT,False) -(EQ,True) -(GT,True) - -(LT,True) -(EQ,False) -(GT,False) - -(LT,True) -(EQ,False) -(GT,True) - -(LT,True) -(EQ,True) -(GT,False) - -(LT,True) -(EQ,True) -(GT,True) -(LT,False) -(EQ,False) -(GT,False) - -(LT,False) -(EQ,False) -(GT,True) - -(LT,False) -(EQ,True) -(GT,False) - -(LT,False) -(EQ,True) -(GT,True) - -(LT,True) -(EQ,False) -(GT,False) - -(LT,True) -(EQ,False) -(GT,True) - -(LT,True) -(EQ,True) -(GT,False) - -(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) - -(EQ,False) -(EQ,True) - -(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 - +{-# 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 + +(LT,False) +(EQ,False) +(GT,False) + +(LT,False) +(EQ,False) +(GT,True) + +(LT,False) +(EQ,True) +(GT,False) + +(LT,False) +(EQ,True) +(GT,True) + +(LT,True) +(EQ,False) +(GT,False) + +(LT,True) +(EQ,False) +(GT,True) + +(LT,True) +(EQ,True) +(GT,False) + +(LT,True) +(EQ,True) +(GT,True) + +(LT,False) +(EQ,False) +(GT,False) + +(LT,False) +(EQ,False) +(GT,True) + +(LT,False) +(EQ,True) +(GT,False) + +(LT,False) +(EQ,True) +(GT,True) + +(LT,True) +(EQ,False) +(GT,False) + +(LT,True) +(EQ,False) +(GT,True) + +(LT,True) +(EQ,True) +(GT,False) + +(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) + +(EQ,False) +(EQ,True) + +(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 + diff --git a/sources/Data/Enumerate/Large.hs b/sources/Data/Enumerate/Large.hs --- a/sources/Data/Enumerate/Large.hs +++ b/sources/Data/Enumerate/Large.hs @@ -1,26 +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 - +{-# 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 + diff --git a/sources/Data/Enumerate/Map.hs b/sources/Data/Enumerate/Map.hs --- a/sources/Data/Enumerate/Map.hs +++ b/sources/Data/Enumerate/Map.hs @@ -1,302 +1,312 @@ -{-# 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 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 - +{-# 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 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 + diff --git a/sources/Data/Enumerate/Reify.hs b/sources/Data/Enumerate/Reify.hs --- a/sources/Data/Enumerate/Reify.hs +++ b/sources/Data/Enumerate/Reify.hs @@ -1,157 +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)) - +{-# 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)) + diff --git a/sources/Data/Enumerate/Types.hs b/sources/Data/Enumerate/Types.hs --- a/sources/Data/Enumerate/Types.hs +++ b/sources/Data/Enumerate/Types.hs @@ -1,360 +1,381 @@ -{-# 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 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@: - -* - - -related packages: - -* . allows infinite lists (by convention). too heavyweight. - -* . no @Generic@ instance. - -* . too heavyweight (testing framework). - -* 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) - +{-# 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 @@ 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@: + +* + + +also provides instances for: + +* sets + +* modular integers + +* vinyl records + + +related packages: + +* . allows infinite lists (by convention). too heavyweight. + +* . no @Generic@ instance. + +* . too heavyweight (testing framework). + +* 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)