universe-instances-base (empty) → 1.0
raw patch · 4 files changed
+184/−0 lines, 4 filesdep +basedep +containersdep +universe-basesetup-changed
Dependencies added: base, containers, universe-base
Files
- Data/Universe/Instances/Base.hs +125/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- universe-instances-base.cabal +27/−0
+ Data/Universe/Instances/Base.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE TypeFamilies #-}+module Data.Universe.Instances.Base (+ -- | Instances of 'Universe' and 'Finite' for built-in types.+ Universe(..), Finite(..)+ ) where++import Control.Monad+import Data.Int+import Data.Map ((!), fromList)+import Data.Monoid+import Data.Ratio+import Data.Universe.Class+import Data.Universe.Helpers+import Data.Word++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 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 Universe a => Universe [a] where+ universe = diagonal $ [[]] : [[h:t | t <- universe] | h <- 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 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 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++-- to add when somebody asks for it: instance (Eq a, Finite a) => Finite (Endo a) (+Universe)
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ universe-instances-base.cabal view
@@ -0,0 +1,27 @@+name: universe-instances-base+version: 1.0+synopsis: Universe instances for types from the base package+homepage: https://github.com/dmwit/universe+license: BSD3+license-file: LICENSE+author: Daniel Wagner+maintainer: me@dmwit.com+copyright: Daniel Wagner 2014+category: Data+build-type: Simple+cabal-version: >=1.10+source-repository head+ type: git+ location: https://github.com/dmwit/universe+source-repository this+ type: git+ location: https://github.com/dmwit/universe+ tag: 1.0++library+ exposed-modules: Data.Universe.Instances.Base+ other-extensions: TypeFamilies+ build-depends: base >=4 && <5,+ containers >=0.5 && <0.6,+ universe-base >=1.0 && <1.1+ default-language: Haskell2010