enumerate 0.2.1 → 0.2.2
raw patch · 16 files changed
+1841/−1582 lines, 16 filesdep +dump-coredep +spirosdep −doctestdep ~arraydep ~basedep ~containerssetup-changednew-component:exe:example-enumerate
Dependencies added: dump-core, spiros
Dependencies removed: doctest
Dependency ranges changed: array, base, containers, ghc-prim, vinyl
Files
- LICENSE +20/−20
- Main.hs +10/−10
- README.md +35/−29
- Setup.hs +2/−2
- enumerate.cabal +131/−114
- sources/Enumerate.hs +90/−90
- sources/Enumerate/Cardinality.hs +216/−214
- sources/Enumerate/Enum.hs +133/−94
- sources/Enumerate/Example.hs +258/−85
- sources/Enumerate/Extra.hs +57/−58
- sources/Enumerate/Main.hs +0/−8
- sources/Enumerate/Orphans/GHC.hs +56/−0
- sources/Enumerate/Orphans/Large.hs +84/−83
- sources/Enumerate/Test.hs +35/−0
- sources/Enumerate/Types.hs +714/−738
- tests/DocTest.hs +0/−37
LICENSE view
@@ -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.
Main.hs view
@@ -1,10 +1,10 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-} -import qualified Enumerate.Example -import qualified Enumerate.Main - -main = do - putStrLn "\nEnumerate.Example..." - Enumerate.Example.main - - putStrLn "\nEnumerate.Main..." - Enumerate.Main.main +{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+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,29 +1,35 @@-# 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, -(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.Enumerate (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 +# 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,+2. a generic instance for automatically deriving it, and++# example++```haskell+ {-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}+ import Data.Enumerate (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/docs/Enumerate.html++http://sboosali.github.io/documentation/enumerate/Enumerate.html (when hackage won't build the haddocks)++# related:++To reify functions, partial or total, into a Map,+see [enumerate-function](https://github.com/sboosali/enumerate-function).
Setup.hs view
@@ -1,2 +1,2 @@-import Distribution.Simple -main = defaultMain +import Distribution.Simple+main = defaultMain
enumerate.cabal view
@@ -1,114 +1,131 @@--- Initial enumerate.cabal generated by cabal init. For further --- documentation, see http://haskell.org/cabal/users-guide/ - -name: enumerate -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. - . - see the "Enumerable" module for extensive documentation. - -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 - -source-repository head - type: git - location: https://github.com/sboosali/enumerate - - -library - exposed-modules: - 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.7 && < 5 - , ghc-prim >=0.3 && < 0.5 - , array ==0.5.* - , template-haskell >=2.9 - , containers ==0.5.* - - -- , modular-arithmetic==1.2.* - , 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 - hs-source-dirs: . - - default-language: Haskell2010 - - build-depends: - 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 +-- Initial enumerate.cabal generated by cabal init. For further+-- documentation, see http://haskell.org/cabal/users-guide/++name: enumerate+version: 0.2.2+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.+ .+ see the "Enumerable" module for extensive documentation.++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++source-repository head+ type: git+ location: https://github.com/sboosali/enumerate++flag dump-core+ description: Dump HTML for the core generated by GHC during compilation+ default: False+++library+ hs-source-dirs: sources++ exposed-modules:+ Enumerate+ Enumerate.Types+ Enumerate.Enum+ Enumerate.Cardinality+ Enumerate.Orphans.Large+ Enumerate.Orphans.GHC++ Enumerate.Example+ Enumerate.Test+ Enumerate.Extra++ -- Enumerate.Domain+ -- Data.CoRec+ -- Data.CoRec.MemoTrie+ -- Data.TEnumerate++ build-depends:+ base >= 4.7 && < 5+ , spiros++ , ghc-prim >=0.3+ , array >=0.5+ , template-haskell >=2.9+ , containers >=0.5++ -- , modular-arithmetic==1.2.*+ , vinyl >=0.5+ , deepseq >= 1.3++ default-language: Haskell2010+ default-extensions: AutoDeriveTypeable DeriveDataTypeable+ DeriveGeneric DeriveFunctor DeriveFoldable DeriveTraversable+ NoImplicitPrelude+ ghc-options:+ -Wall+ -fno-warn-unticked-promoted-constructors++ -- stack build --flag enumerate:dump-core + if flag(dump-core)+ build-depends: dump-core+ ghc-options: -fplugin=DumpCore -fplugin-opt DumpCore:core++-- $ stack build && stack exec example-enumerate+executable example-enumerate++ main-is: Main.hs+ hs-source-dirs: .++ default-language: Haskell2010++ build-depends:+ 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/Enumerate.hs view
@@ -1,90 +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 +{-| 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
@@ -1,214 +1,216 @@-{-# 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) +{-# 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 Enumerate.Extra++import Data.Vinyl (Rec)++import GHC.Generics+-- 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 ++-- 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
@@ -1,94 +1,133 @@-{-# 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 +{-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+ +{-|++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++ , minBound_enumerable'+ , maxBound_enumerable'++ , toEnum_enumerable'+ , fromEnum_enumerable'++ , array_enumerable+ , table_enumerable++ , toEnumDefault+ , fromEnumDefault+ ) where++import Enumerate.Types+import Enumerate.Extra++import qualified Data.Array as Array --IntMap+import Data.Array (Array, (!))+import qualified Data.Map as Map+import Data.Map (Map)+import Prelude (error)+++--TODO check core for sharing+minBound_enumerable' :: forall a. (Enumerable a) => a +minBound_enumerable' = minBound_enumerable array_enumerable+{-# INLINE minBound_enumerable' #-}++maxBound_enumerable' :: forall a. (Enumerable a) => a+maxBound_enumerable' = maxBound_enumerable array_enumerable+{-# INLINE maxBound_enumerable' #-}+++toEnum_enumerable' :: forall a. (Enumerable a) => (Int -> a)+toEnum_enumerable' = toEnum_enumerable array_enumerable+{-# INLINE toEnum_enumerable' #-}++fromEnum_enumerable' :: forall a. (Enumerable a, Ord a) => (a -> Int)+fromEnum_enumerable' = fromEnum_enumerable table_enumerable+{-# INLINE fromEnum_enumerable' #-}+++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])++toEnumDefault :: forall a. (Enumerable a) => Int -> a+toEnumDefault = toEnum_enumerable array_enumerable+-- use NOINLINE such that array_enumerable is reused+{-# NOINLINE toEnumDefault #-}++fromEnumDefault :: forall a. (Enumerable a, Ord a) => a -> Int+fromEnumDefault = fromEnum_enumerable table_enumerable+-- use NOINLINE such that table_enumerable is reused+{-# NOINLINE fromEnumDefault #-}++__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
@@ -1,85 +1,258 @@-{-# 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 +{-# LANGUAGE LambdaCase, DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE FlexibleInstances #-}+{- |++++## Bounded Enum instance++You can (semi-)automatically derive efficient 'Bounded'/'Enum' +instances:++@+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'+@++## Run++@+stack build && stack exec -- enumerable-example+@++outputs:++@+-- A Void+>>> cardinality ([]::[A Void])+1+>>> _ <- traverse print (enumerated :: [A Void])+A3 (fromList [])+++-- A ()+>>> cardinality ([]::[A ()])+8+>>> _ <- traverse print (enumerated :: [A ()])+A0 ()+A1 Nothing (Left ())+A1 Nothing (Right ())+A1 (Just ()) (Left ())+A1 (Just ()) (Right ())+A2 ((),())+A3 (fromList [])+A3 (fromList [()])+++-- A Bool+>>> cardinality ([]::[A Bool])+22+>>> _ <- traverse print (enumerated :: [A Bool])+A0 False+A0 True+A1 Nothing (Left False)+A1 Nothing (Left True)+A1 Nothing (Right False)+A1 Nothing (Right True)+A1 (Just False) (Left False)+A1 (Just False) (Left True)+A1 (Just False) (Right False)+A1 (Just False) (Right True)+A1 (Just True) (Left False)+A1 (Just True) (Left True)+A1 (Just True) (Right False)+A1 (Just True) (Right True)+A2 (False,False)+A2 (False,True)+A2 (True,False)+A2 (True,True)+A3 (fromList [])+A3 (fromList [False])+A3 (fromList [False,True])+A3 (fromList [True])+++-- A Ordering+>>> cardinality ([]::[A Ordering])+44+>>>_ <- traverse print (enumerated :: [A Ordering])+A0 LT+A0 EQ+A0 GT+A1 Nothing (Left LT)+A1 Nothing (Left EQ)+A1 Nothing (Left GT)+A1 Nothing (Right LT)+A1 Nothing (Right EQ)+A1 Nothing (Right GT)+A1 (Just LT) (Left LT)+A1 (Just LT) (Left EQ)+A1 (Just LT) (Left GT)+A1 (Just LT) (Right LT)+A1 (Just LT) (Right EQ)+A1 (Just LT) (Right GT)+A1 (Just EQ) (Left LT)+A1 (Just EQ) (Left EQ)+A1 (Just EQ) (Left GT)+A1 (Just EQ) (Right LT)+A1 (Just EQ) (Right EQ)+A1 (Just EQ) (Right GT)+A1 (Just GT) (Left LT)+A1 (Just GT) (Left EQ)+A1 (Just GT) (Left GT)+A1 (Just GT) (Right LT)+A1 (Just GT) (Right EQ)+A1 (Just GT) (Right GT)+A2 (LT,LT)+A2 (LT,EQ)+A2 (LT,GT)+A2 (EQ,LT)+A2 (EQ,EQ)+A2 (EQ,GT)+A2 (GT,LT)+A2 (GT,EQ)+A2 (GT,GT)+A3 (fromList [])+A3 (fromList [LT])+A3 (fromList [LT,EQ])+A3 (fromList [LT,EQ,GT])+A3 (fromList [LT,GT])+A3 (fromList [EQ])+A3 (fromList [EQ,GT])+A3 (fromList [GT])++@++-}+module Enumerate.Example where+import Enumerate+import Prelude++import Data.Array (Array)+import Data.Map (Map)+import Data.Set (Set)+import Data.Ord (Ordering)++--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]++ putStrLn "\nreifyCardinality @Bool..."+ print $ reifyCardinality [False]+ putStrLn "\n"++ putStrLn "\n\n-- A Void"+ putStrLn ">>> cardinality ([]::[A Void])"+ print $ cardinality ([]::[A Void])+ putStrLn ">>> enumerated :: [A Void]"+ traverse print (enumerated :: [A Void])++ putStrLn "\n\n-- A ()"+ putStrLn ">>> cardinality ([]::[A ()])"+ print $ cardinality ([]::[A ()])+ putStrLn ">>> enumerated :: [A ()]"+ traverse print (enumerated :: [A ()])++ putStrLn "\n\n-- A Bool"+ putStrLn ">>> cardinality ([]::[A Bool])"+ print $ cardinality ([]::[A Bool])+ putStrLn ">>> enumerated :: [A Bool]"+ traverse print (enumerated :: [A Bool])++ putStrLn "\n\n-- A Ordering"+ putStrLn ">>> cardinality ([]::[A Ordering])"+ print $ cardinality ([]::[A Ordering])+ putStrLn ">>> enumerated :: [A Ordering]"+ traverse print (enumerated :: [A Ordering])++{- | (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)++data A a+ = A0 a+ | A1 (Maybe a) (Either a a)+ | A2 (a, a)+ | A3 (Set a)+ deriving (Show,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
@@ -1,58 +1,57 @@-{-# 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() +{-# LANGUAGE LambdaCase, ScopedTypeVariables #-}+{-|++-}+module Enumerate.Extra+ ( module Enumerate.Extra+ , module Prelude.Spiros+ ) where+++-- import Language.Haskell.TH.Syntax (Name,nameBase)+import Numeric.Natural+import qualified Data.Set as Set+import qualified Data.List as List+import qualified Data.Ord as Ord+import Prelude.Spiros hiding ((:*:),C) -- shadows GHC.Generics+++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
@@ -1,8 +0,0 @@-module Enumerate.Main where -import Enumerate - -main = do - putStrLn "\nreifyCardinality @Bool..." - print $ reifyCardinality [False] - - putStrLn "\n"
+ sources/Enumerate/Orphans/GHC.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}++{-|++-}+module Enumerate.Orphans.GHC where+import Enumerate.Types+import Enumerate.Extra++import System.Posix.Types (CIno,CMode)+import GHC.Exts(Down(..),SpecConstrAnnotation(..))+--+-- TODO CCc+-- import GHC.Conc.Windows (ConsoleEvent) -- platform-specific module+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)++instance Enumerable CIno where+ enumerated = boundedEnumerated+ cardinality = boundedCardinality+instance Enumerable CMode where+ enumerated = boundedEnumerated+ cardinality = boundedCardinality++instance (Enumerable a) => Enumerable (Down a) where+ enumerated = Down <$> enumerated++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
sources/Enumerate/Orphans/Large.hs view
@@ -1,83 +1,84 @@-{-# 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 +{-# 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.Extra+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/Test.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE LambdaCase, DeriveGeneric, DeriveAnyClass #-}+{-# LANGUAGE FlexibleInstances #-}+{-| test that nullary method calls are shared. ++TODO cross-module benchmark and core check.++@+stack build --flag enumerate:dump-core && open core/Enumerate.Test.html+@++-}+module Enumerate.Test where+import Enumerate+import Prelude++import Data.Set (Set)+import GHC.Generics (Generic)++data B a+ = B0 a+ | B1 (Maybe a) (Either a a)+ | B2 (a, a)+ | B3 (Set a)+ deriving (Show,Eq,Ord,Generic,Enumerable)++instance Bounded (B Bool) where+ minBound = minBound_enumerable' -- fast via laziness of lists, but arrays are spine-strict+ maxBound = maxBound_enumerable' ++instance Enum (B Bool) where+ toEnum = toEnum_enumerable' + fromEnum = fromEnum_enumerable' -- needs Ord++things = [minBound_enumerable', maxBound_enumerable', toEnum_enumerable' 9] :: [B Bool]+
sources/Enumerate/Types.hs view
@@ -1,738 +1,714 @@-{-# 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) +{-# LANGUAGE RankNTypes, ScopedTypeVariables, DefaultSignatures, TypeOperators #-}+{-# LANGUAGE FlexibleInstances, FlexibleContexts, LambdaCase #-}+{-# LANGUAGE TypeFamilies, ExplicitNamespaces, DataKinds, UndecidableInstances #-}++{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-}++{- | enumerate all values in a finite type.++e.g.++@+data A+ = A0 Bool+ | A1 (Either Bool) (Maybe Bool)+ | A2 (Bool, Bool)+ | A3 (Set Bool)+ deriving (Show,Generic,Enumerable)++> enumerate+A0 False+A0 True+A1 ...++> cardinality ([]::[A])++@++see the 'Enumerable' class for documentation.++see "Enumerate.Example" for examples.++can also help automatically derive @<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 (force)++import qualified Data.Set as Set+import GHC.Generics+import System.Timeout (timeout)+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 Prelude (Enum(..))++-- 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,(%)) -- from Prelude.Spiros+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 Data.Modular (not on stack)+-- * modular integers+++{-$setup++>>> import Prelude++-}++{- | 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).++Every type in `base` (that can be an instance) is an instance.++-}+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++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++{- 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 `lessThan` 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
@@ -1,37 +0,0 @@-{-# 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" - ]