universe 0.0 → 0.1
raw patch · 8 files changed
+135/−12 lines, 8 filesdep +comonad-transformersdep +containersdep +keys
Dependencies added: comonad-transformers, containers, keys, mtl, representable-functors, transformers
Files
- Data/Universe.hs +51/−8
- Data/Universe/Helpers.hs +8/−1
- Data/Universe/Instances.hs +10/−0
- Data/Universe/Instances/Eq.hs +10/−0
- Data/Universe/Instances/Ord.hs +12/−0
- Data/Universe/Instances/Read.hs +12/−0
- Data/Universe/Instances/Show.hs +9/−0
- universe.cabal +23/−3
Data/Universe.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE FlexibleContexts, TypeFamilies #-} module Data.Universe ( -- | Bottoms are ignored for this entire module: only fully-defined inhabitants are considered inhabitants. Universe(..)@@ -5,14 +6,23 @@ ) where import Control.Monad-import Data.Universe.Helpers import Data.Int+import Data.Map ((!), fromList) import Data.Monoid import Data.Ratio+import Data.Universe.Helpers import Data.Void import Data.Word --- TODO: add that we ignore bottoms everywhere in this module+-- 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@@ -61,21 +71,52 @@ instance Universe a => Universe (First a) where universe = map First universe instance Universe a => Universe (Last a) where universe = map Last universe --- | Some contortions to avoid extensions. The only instance of this class is 'Integer'.-class Integral a => IsInteger a-instance IsInteger Integer- -- see http://mathlesstraveled.com/2008/01/07/recounting-the-rationals-part-ii-fractions-grow-on-trees/ -- TODO: since we know these numerators and denominators are always going to be -- in reduced terms, we could use (:%) when we know we're compiling with GHC to -- get a small speed boost-positiveRationals :: IsInteger a => [Ratio a]+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 IsInteger a => Universe (Ratio a) where universe = 0 : map negate positiveRationals +++ positiveRationals+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++-- instances for Representable functors; in general we want+-- instance (Finite (Key f), Ord (Key f), Universe a, Representable f)+-- => Universe (f a)+-- where universe = map tabulate universe+-- but this has ridiculous overlap, so we expand this for each of the+-- instantiations of f that are Representable instead++instance Universe a => Universe (Identity a) where universe = map Identity universe+instance (Representable f, Finite (Key f), Ord (Key f), Universe a)+ => Universe (IdentityT f a)+ where universe = map tabulate universe+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 (Representable f, Finite e, Ord e, Finite (Key f), Ord (Key f), Universe a)+ => Universe (ReaderT e f a)+ where universe = map tabulate universe+instance (Representable f, Representable g, Finite (Key f), Ord (Key f), Finite (Key g), Ord (Key g), Universe a)+ => Universe (Compose f g a)+ where universe = map tabulate universe+instance (Representable f, Representable g, Finite (Key f), Ord (Key f), Finite (Key g), Ord (Key g), Universe a)+ => Universe (Functor.Product f g a)+ where universe = map tabulate universe+ instance Finite () instance Finite Bool instance Finite Char@@ -106,6 +147,8 @@ 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) -- to add as people ask for them: -- instance (Eq a, Finite a) => Finite (Endo a) (+Universe)
Data/Universe/Helpers.hs view
@@ -27,7 +27,14 @@ -- | Fair 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 list, @(v,w)@ has finite index in the output list.+-- input lists, @(v,w)@ has finite index in the output list. (+*+) :: [a] -> [b] -> [(a,b)] (x:xs) +*+ ys = map ((,) x) ys +++ (xs +*+ ys) [] +*+ ys = []++-- | Fair 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 (:)) .) . (+*+)) [[]]
+ Data/Universe/Instances.hs view
@@ -0,0 +1,10 @@+module Data.Universe.Instances (+ -- | A convenience module that imports the submodules @Eq@, @Ord@, @Show@,+ -- and @Read@ 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
+ Data/Universe/Instances/Eq.hs view
@@ -0,0 +1,10 @@+module 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]
+ Data/Universe/Instances/Ord.hs view
@@ -0,0 +1,12 @@+module 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]
+ Data/Universe/Instances/Read.hs view
@@ -0,0 +1,12 @@+module 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]
+ Data/Universe/Instances/Show.hs view
@@ -0,0 +1,9 @@+module 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.cabal view
@@ -1,5 +1,5 @@ name: universe-version: 0.0+version: 0.1 synopsis: Classes for types where we know all the values description: A small package, in the spirit of data-default, which allows the munging of finite and recursively enumerable types license: BSD3@@ -10,7 +10,27 @@ 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.1 library- exposed-modules: Data.Universe, Data.Universe.Helpers- build-depends: base >=4 && <5, void >=0.1 && <0.6+ 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+ build-depends: base >=4 && <5 ,+ comonad-transformers >=0.1 && <3.1,+ containers >=0.1 && <1 ,+ keys >=0.1 && <4 ,+ mtl >=1.0 && <2.2,+ representable-functors >=2.4 && <3.1,+ transformers >=0.2 && <0.4,+ void >=0.1 && <0.6