diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,20 +1,20 @@ -Copyright (c) 2015 Sam Boosalis - -Permission is hereby granted, free of charge, to any person obtaining -a copy of this software and associated documentation files (the -"Software"), to deal in the Software without restriction, including -without limitation the rights to use, copy, modify, merge, publish, -distribute, sublicense, and/or sell copies of the Software, and to -permit persons to whom the Software is furnished to do so, subject to -the following conditions: - -The above copyright notice and this permission notice shall be included -in all copies or substantial portions of the Software. - -THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, -EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY -CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, -TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE -SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +Copyright (c) 2015 Sam Boosalis + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -1,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 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,29 +1,35 @@ -# enumerate - -[![Hackage](https://img.shields.io/hackage/v/enumerate.svg)](https://hackage.haskell.org/package/enumerate) -[![Build Status](https://secure.travis-ci.org/sboosali/enumerate.svg)](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 + +[![Hackage](https://img.shields.io/hackage/v/enumerate.svg)](https://hackage.haskell.org/package/enumerate) +[![Build Status](https://secure.travis-ci.org/sboosali/enumerate.svg)](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). diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple -main = defaultMain +import Distribution.Simple +main = defaultMain diff --git a/enumerate.cabal b/enumerate.cabal --- a/enumerate.cabal +++ b/enumerate.cabal @@ -1,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 diff --git a/sources/Enumerate.hs b/sources/Enumerate.hs --- a/sources/Enumerate.hs +++ b/sources/Enumerate.hs @@ -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 diff --git a/sources/Enumerate/Cardinality.hs b/sources/Enumerate/Cardinality.hs --- a/sources/Enumerate/Cardinality.hs +++ b/sources/Enumerate/Cardinality.hs @@ -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) diff --git a/sources/Enumerate/Enum.hs b/sources/Enumerate/Enum.hs --- a/sources/Enumerate/Enum.hs +++ b/sources/Enumerate/Enum.hs @@ -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 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 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 diff --git a/sources/Enumerate/Example.hs b/sources/Enumerate/Example.hs --- a/sources/Enumerate/Example.hs +++ b/sources/Enumerate/Example.hs @@ -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 + +------------------------------------------------------- diff --git a/sources/Enumerate/Extra.hs b/sources/Enumerate/Extra.hs --- a/sources/Enumerate/Extra.hs +++ b/sources/Enumerate/Extra.hs @@ -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() diff --git a/sources/Enumerate/Main.hs b/sources/Enumerate/Main.hs deleted file mode 100644 --- a/sources/Enumerate/Main.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Enumerate.Main where -import Enumerate - -main = do - putStrLn "\nreifyCardinality @Bool..." - print $ reifyCardinality [False] - - putStrLn "\n" diff --git a/sources/Enumerate/Orphans/GHC.hs b/sources/Enumerate/Orphans/GHC.hs new file mode 100644 --- /dev/null +++ b/sources/Enumerate/Orphans/GHC.hs @@ -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 diff --git a/sources/Enumerate/Orphans/Large.hs b/sources/Enumerate/Orphans/Large.hs --- a/sources/Enumerate/Orphans/Large.hs +++ b/sources/Enumerate/Orphans/Large.hs @@ -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 diff --git a/sources/Enumerate/Test.hs b/sources/Enumerate/Test.hs new file mode 100644 --- /dev/null +++ b/sources/Enumerate/Test.hs @@ -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] + diff --git a/sources/Enumerate/Types.hs b/sources/Enumerate/Types.hs --- a/sources/Enumerate/Types.hs +++ b/sources/Enumerate/Types.hs @@ -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 @@ 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 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@: - -* - -also provides instances for: - -* sets - -* vinyl records - -related packages: - -* . -no @Generic@ instance. - -* -no @Generic@ instance. - -* -only @Enum@s - -* . - allows infinite lists (by convention). too heavyweight. - -* . -too heavyweight (testing framework). - -* -too heavyweight (testing framework). Series enumerates up to some depth and can enumerated infinitely-inhabited types. - -* -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 @@ 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 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@: + +* + +also provides instances for: + +* sets + +* vinyl records + +related packages: + +* . +no @Generic@ instance. + +* +no @Generic@ instance. + +* +only @Enum@s + +* . + allows infinite lists (by convention). too heavyweight. + +* . +too heavyweight (testing framework). + +* +too heavyweight (testing framework). Series enumerates up to some depth and can enumerated infinitely-inhabited types. + +* +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) diff --git a/tests/DocTest.hs b/tests/DocTest.hs deleted file mode 100644 --- a/tests/DocTest.hs +++ /dev/null @@ -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" - ]