universe-0.4.0.4/0000755000000000000000000000000012247443261011710 5ustar0000000000000000universe-0.4.0.4/LICENSE0000644000000000000000000000276412247443261012726 0ustar0000000000000000Copyright (c) 2013, Daniel Wagner All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Daniel Wagner nor the names of other contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. universe-0.4.0.4/Setup.hs0000644000000000000000000000005612247443261013345 0ustar0000000000000000import Distribution.Simple main = defaultMain universe-0.4.0.4/universe.cabal0000644000000000000000000000315612247443261014541 0ustar0000000000000000name: universe version: 0.4.0.4 synopsis: Classes for types where we know all the values description: Munge finite and recursively enumerable types license: BSD3 license-file: LICENSE author: Daniel Wagner maintainer: daniel@wagner-home.com copyright: 2013 Daniel Wagner category: Data build-type: Simple cabal-version: >=1.8 source-repository head type: git location: https://github.com/dmwit/universe source-repository this type: git location: https://github.com/dmwit/universe tag: 0.4.0.4 library exposed-modules: Data.Universe, Data.Universe.Helpers, Data.Universe.Instances, Data.Universe.Instances.Eq, Data.Universe.Instances.Ord, Data.Universe.Instances.Read, Data.Universe.Instances.Show, Data.Universe.Instances.Traversable if impl(ghc >= 7.4) cpp-options: -DDEFAULT_SIGNATURES build-depends: base >=4 && <5 , comonad-transformers >=0.1 && <4.0, containers >=0.1 && <1 , keys >=0.1 && <4 , mtl >=1.0 && <2.2, representable-functors >=2.4 && <3.3, transformers >=0.2 && <0.4, void >=0.1 && <0.7 universe-0.4.0.4/Data/0000755000000000000000000000000012247443261012561 5ustar0000000000000000universe-0.4.0.4/Data/Universe.hs0000644000000000000000000002352512247443261014724 0ustar0000000000000000{-# LANGUAGE CPP, FlexibleContexts, TypeFamilies #-} #ifdef DEFAULT_SIGNATURES {-# LANGUAGE DefaultSignatures #-} #endif module Data.Universe ( -- | Bottoms are ignored for this entire module: only fully-defined inhabitants are considered inhabitants. Universe(..) , Finite(..) ) where import Control.Monad import Data.Int import Data.Map ((!), fromList) import Data.Monoid import Data.Ratio import Data.Universe.Helpers import Data.Void import Data.Word -- for representable stuff! import Control.Comonad.Trans.Traced import Control.Monad.Identity import Control.Monad.Reader import Control.Monad.Trans.Identity import Data.Functor.Compose import Data.Functor.Representable import Data.Key (Key) import qualified Data.Functor.Product as Functor -- | Creating an instance of this class is a declaration that your type is -- recursively enumerable (and that 'universe' is that enumeration). In -- particular, you promise that any finite inhabitant has a finite index in -- 'universe', and that no inhabitant appears at two different finite indices. class Universe a where universe :: [a] #ifdef DEFAULT_SIGNATURES default universe :: (Enum a, Bounded a) => [a] universe = universeDef #endif -- | Creating an instance of this class is a declaration that your 'universe' -- eventually ends. Minimal definition: no methods defined. By default, -- @universeF = universe@, but for some types (like 'Either') the 'universeF' -- method may have a more intuitive ordering. class Universe a => Finite a where universeF :: [a] universeF = universe instance Universe () where universe = universeDef instance Universe Bool where universe = universeDef instance Universe Char where universe = universeDef instance Universe Ordering where universe = universeDef instance Universe Integer where universe = [0, -1..] +++ [1..] instance Universe Int where universe = universeDef instance Universe Int8 where universe = universeDef instance Universe Int16 where universe = universeDef instance Universe Int32 where universe = universeDef instance Universe Int64 where universe = universeDef instance Universe Word where universe = universeDef instance Universe Word8 where universe = universeDef instance Universe Word16 where universe = universeDef instance Universe Word32 where universe = universeDef instance Universe Word64 where universe = universeDef instance Universe Void where universe = [] instance (Universe a, Universe b) => Universe (Either a b) where universe = map Left universe +++ map Right universe instance Universe a => Universe (Maybe a ) where universe = Nothing : map Just universe instance (Universe a, Universe b) => Universe (a, b) where universe = universe +*+ universe instance (Universe a, Universe b, Universe c) => Universe (a, b, c) where universe = [(a,b,c) | ((a,b),c) <- universe +*+ universe +*+ universe] instance (Universe a, Universe b, Universe c, Universe d) => Universe (a, b, c, d) where universe = [(a,b,c,d) | (((a,b),c),d) <- universe +*+ universe +*+ universe +*+ universe] instance (Universe a, Universe b, Universe c, Universe d, Universe e) => Universe (a, b, c, d, e) where universe = [(a,b,c,d,e) | ((((a,b),c),d),e) <- universe +*+ universe +*+ universe +*+ universe +*+ universe] instance Finite a => Universe [a] where universe = [] : interleave [[h:t | t <- universe] | h <- universe] -- probably also possible, but wait until somebody demands it: -- instance Universe a => Universe [a] where universe = {- something using choices and diagonal and replicate n universe -} instance Universe All where universe = map All universe instance Universe Any where universe = map Any universe instance Universe a => Universe (Sum a) where universe = map Sum universe instance Universe a => Universe (Product a) where universe = map Product universe instance Universe a => Universe (Dual a) where universe = map Dual universe instance Universe a => Universe (First a) where universe = map First universe instance Universe a => Universe (Last a) where universe = map Last universe -- see http://mathlesstraveled.com/2008/01/07/recounting-the-rationals-part-ii-fractions-grow-on-trees/ -- -- also, Brent Yorgey writes: -- -- positiveRationals2 :: [Ratio Integer] -- positiveRationals2 = iterate' next 1 -- where -- next x = let (n,y) = properFraction x in recip (fromInteger n + 1 - y) -- iterate' f x = let x' = f x in x' `seq` (x : iterate' f x') -- -- Compiling this code with -O2 and doing some informal tests seems to -- show that positiveRationals and positiveRationals2 have almost exactly -- the same efficiency for generating the entire list (e.g. the times for -- finding the sum of the first 100000 rationals are pretty much -- indistinguishable). positiveRationals is still the clear winner for -- generating just the nth rational for some particular n -- some simple -- experiments seem to indicate that doing this with positiveRationals2 -- scales linearly while with positiveRationals it scales sub-linearly, -- as expected. -- -- Surprisingly, replacing % with :% in positiveRationals seems to make -- no appreciable difference. positiveRationals :: [Ratio Integer] positiveRationals = 1 : map lChild positiveRationals +++ map rChild positiveRationals where lChild frac = numerator frac % (numerator frac + denominator frac) rChild frac = (numerator frac + denominator frac) % denominator frac instance a ~ Integer => Universe (Ratio a) where universe = 0 : map negate positiveRationals +++ positiveRationals -- could change the Ord constraint to an Eq one, but come on, how many finite -- types can't be ordered? instance (Finite a, Ord a, Universe b) => Universe (a -> b) where universe = map tableToFunction tables where tables = choices [universe | _ <- monoUniverse] tableToFunction = (!) . fromList . zip monoUniverse monoUniverse = universeF instance Universe a => Universe (Identity a) where universe = map Identity universe instance Universe (f a) => Universe (IdentityT f a) where universe = map IdentityT universe instance (Finite e, Ord e, Universe (m a)) => Universe (ReaderT e m a) where universe = map ReaderT universe instance Universe (f (g a)) => Universe (Compose f g a) where universe = map Compose universe instance (Universe (f a), Universe (g a)) => Universe (Functor.Product f g a) where universe = [Functor.Pair f g | (f, g) <- universe +*+ universe] -- We could do this: -- -- instance Universe (f a) => Universe (Rep f a) where universe = map Rep universe -- -- However, since you probably only apply Rep to functors when you want to -- think of them as being representable, I think it makes sense to use an -- instance based on the representable-ness rather than the inherent -- universe-ness. -- -- Please complain if you disagree! instance (Representable f, Finite (Key f), Ord (Key f), Universe a) => Universe (Rep f a) where universe = map tabulate universe instance (Representable f, Finite s, Ord s, Finite (Key f), Ord (Key f), Universe a) => Universe (TracedT s f a) where universe = map tabulate universe instance Finite () instance Finite Bool instance Finite Char instance Finite Ordering instance Finite Int instance Finite Int8 instance Finite Int16 instance Finite Int32 instance Finite Int64 instance Finite Word instance Finite Word8 instance Finite Word16 instance Finite Word32 instance Finite Word64 instance Finite Void instance Finite a => Finite (Maybe a ) instance (Finite a, Finite b) => Finite (Either a b) where universeF = map Left universe ++ map Right universe instance (Finite a, Finite b) => Finite (a, b) where universeF = liftM2 (,) universeF universeF instance (Finite a, Finite b, Finite c) => Finite (a, b, c) where universeF = liftM3 (,,) universeF universeF universeF instance (Finite a, Finite b, Finite c, Finite d) => Finite (a, b, c, d) where universeF = liftM4 (,,,) universeF universeF universeF universeF instance (Finite a, Finite b, Finite c, Finite d, Finite e) => Finite (a, b, c, d, e) where universeF = liftM5 (,,,,) universeF universeF universeF universeF universeF instance Finite All where universeF = map All universeF instance Finite Any where universeF = map Any universeF instance Finite a => Finite (Sum a) where universeF = map Sum universeF instance Finite a => Finite (Product a) where universeF = map Product universeF instance Finite a => Finite (Dual a) where universeF = map Dual universeF instance Finite a => Finite (First a) where universeF = map First universeF instance Finite a => Finite (Last a) where universeF = map Last universeF instance (Ord a, Finite a, Finite b) => Finite (a -> b) where universeF = map tableToFunction tables where tables = sequence [universeF | _ <- monoUniverse] tableToFunction = (!) . fromList . zip monoUniverse monoUniverse = universeF instance Finite a => Finite (Identity a) where universeF = map Identity universeF instance Finite (f a) => Finite (IdentityT f a) where universeF = map IdentityT universeF instance (Finite e, Ord e, Finite (m a)) => Finite (ReaderT e m a) where universeF = map ReaderT universeF instance Finite (f (g a)) => Finite (Compose f g a) where universeF = map Compose universeF instance (Finite (f a), Finite (g a)) => Finite (Functor.Product f g a) where universeF = liftM2 Functor.Pair universeF universeF instance (Representable f, Finite (Key f), Ord (Key f), Finite a) => Finite (Rep f a) where universeF = map tabulate universeF instance (Representable f, Finite s, Ord s, Finite (Key f), Ord (Key f), Finite a) => Finite (TracedT s f a) where universeF = map tabulate universeF -- to add as people ask for them: -- instance (Eq a, Finite a) => Finite (Endo a) (+Universe) -- instance (Ord a, Universe a) => Universe (Set a) (+Finite) -- instance (Ord k, Universe k, Universe v) => Universe (Map k v) (+Finite) universe-0.4.0.4/Data/Universe/0000755000000000000000000000000012247443261014361 5ustar0000000000000000universe-0.4.0.4/Data/Universe/Helpers.hs0000644000000000000000000000626612247443261016331 0ustar0000000000000000module Data.Universe.Helpers ( -- | This module is for functions that are useful for writing instances, -- but not necessarily for using them (and hence are not exported by the -- main module to avoid cluttering up the namespace). module Data.Universe.Helpers ) where import Data.List -- | For many types, the 'universe' should be @[minBound .. maxBound]@; -- 'universeDef' makes it easy to make such types an instance of 'Universe' via -- the snippet -- -- > instance Universe Foo where universe = universeDef universeDef :: (Bounded a, Enum a) => [a] universeDef = [minBound .. maxBound] -- | Fair n-way interleaving: given a finite number of (possibly infinite) -- lists, produce a single list such that whenever @v@ has finite index in one -- of the input lists, @v@ also has finite index in the output list. No list's -- elements occur more frequently (on average) than another's. interleave :: [[a]] -> [a] interleave = concat . transpose -- | Unfair n-way interleaving: given a possibly infinite number of (possibly -- infinite) lists, produce a single list such that whenever @v@ has finite -- index in an input list at finite index, @v@ also has finite index in the -- output list. Elements from lists at lower index occur more frequently, but -- not exponentially so. diagonal :: [[a]] -> [a] diagonal xss = go ([], xss) where go (b, [] ) = interleave b go (b, e:es) = [h | h:_ <- b] ++ go (e:[t | _:t <- b],es) -- | Fair 2-way interleaving. (+++) :: [a] -> [a] -> [a] xs +++ ys = interleave [xs,ys] -- | Slightly unfair 2-way Cartesian product: given two (possibly infinite) -- lists, produce a single list such that whenever @v@ and @w@ have finite -- indices in the input lists, @(v,w)@ has finite index in the output list. -- Lower indices occur as the @fst@ part of the tuple more frequently, but not -- exponentially so. (+*+) :: [a] -> [b] -> [(a,b)] [] +*+ _ = [] -- special case: don't want to construct an infinite list of empty lists to pass to diagonal xs +*+ ys = diagonal [[(x, y) | x <- xs] | y <- ys] -- | Slightly unfair n-way Cartesian product: given a finite number of -- (possibly infinite) lists, produce a single list such that whenever @vi@ has -- finite index in list i for each i, @[v1, ..., vn]@ has finite index in the -- output list. choices :: [[a]] -> [[a]] choices = foldr ((map (uncurry (:)) .) . (+*+)) [[]] -- | Very unfair 2-way Cartesian product: same guarantee as the slightly unfair -- one, except that lower indices may occur as the @fst@ part of the tuple -- exponentially more frequently. This mainly exists as a specification to test -- against. unfairCartesianProduct :: [a] -> [b] -> [(a,b)] unfairCartesianProduct _ [] = [] -- special case: don't want to walk down xs forever hoping one of them will produce a nonempty thing unfairCartesianProduct xs ys = go xs ys where go (x:xs) ys = map ((,) x) ys +++ go xs ys go [] ys = [] -- | Very unfair n-way Cartesian product: same guarantee as the slightly unfair -- one, but not as good in the same sense that the very unfair 2-way product is -- worse than the slightly unfair 2-way product. Mainly for testing purposes. unfairChoices :: [[a]] -> [[a]] unfairChoices = foldr ((map (uncurry (:)) .) . unfairCartesianProduct) [[]] universe-0.4.0.4/Data/Universe/Instances.hs0000644000000000000000000000063112247443261016644 0ustar0000000000000000module Data.Universe.Instances ( -- | A convenience module that imports the submodules @Eq@, @Ord@, @Show@, -- @Read@, and @Traversable@ to provide instances of these classes for -- functions over finite inputs. ) where import Data.Universe.Instances.Eq import Data.Universe.Instances.Ord import Data.Universe.Instances.Show import Data.Universe.Instances.Read import Data.Universe.Instances.Traversable universe-0.4.0.4/Data/Universe/Instances/0000755000000000000000000000000012247443261016310 5ustar0000000000000000universe-0.4.0.4/Data/Universe/Instances/Eq.hs0000644000000000000000000000044412247443261017213 0ustar0000000000000000module Data.Universe.Instances.Eq ( -- | An 'Eq' instance for functions, given the input is 'Finite' and the -- output is 'Eq'. Compares pointwise. ) where import Data.Monoid import Data.Universe instance (Finite a, Eq b) => Eq (a -> b) where f == g = and [f x == g x | x <- universeF] universe-0.4.0.4/Data/Universe/Instances/Ord.hs0000644000000000000000000000064412247443261017374 0ustar0000000000000000module Data.Universe.Instances.Ord ( -- | An 'Ord' instance for functions, given the input is 'Finite' and the -- output is 'Ord'. Compares pointwise, with higher priority to inputs -- that appear earlier in 'universeF'. ) where import Data.Monoid import Data.Universe import Data.Universe.Instances.Eq instance (Finite a, Ord b) => Ord (a -> b) where f `compare` g = mconcat [f x `compare` g x | x <- universeF] universe-0.4.0.4/Data/Universe/Instances/Read.hs0000644000000000000000000000074712247443261017527 0ustar0000000000000000module Data.Universe.Instances.Read ( -- | A 'Read' instance for functions, given the input is 'Finite' and -- 'Ord' and both the input and output are 'Read'. ) where import Data.Map (fromList, (!)) import Data.Universe -- actually, the "Finite a" part of the context wouldn't be inferred if you -- asked GHC -- but it's kind of hopeless otherwise! instance (Finite a, Ord a, Read a, Read b) => Read (a -> b) where readsPrec n s = [((fromList v !), s') | (v, s') <- readsPrec n s] universe-0.4.0.4/Data/Universe/Instances/Show.hs0000644000000000000000000000045312247443261017566 0ustar0000000000000000module Data.Universe.Instances.Show ( -- | A 'Show' instance for functions, given the input is 'Finite' and both -- the input and output are 'Show'. ) where import Data.Universe instance (Finite a, Show a, Show b) => Show (a -> b) where showsPrec n f = showsPrec n [(a, f a) | a <- universeF] universe-0.4.0.4/Data/Universe/Instances/Traversable.hs0000644000000000000000000000111612247443261021115 0ustar0000000000000000module Data.Universe.Instances.Traversable ( -- | A 'Foldable' instance for functions, given the input is 'Finite', and -- a 'Traversable' instance for functions, given the input is 'Ord' and -- 'Finite'. ) where import Control.Applicative import Data.Foldable import Data.Map ((!), fromList) import Data.Monoid import Data.Traversable import Data.Universe instance Finite e => Foldable ((->) e) where foldMap f g = mconcat $ map (f . g) universeF instance (Ord e, Finite e) => Traversable ((->) e) where sequenceA f = (!) . fromList <$> sequenceA [(,) x <$> f x | x <- universeF]