[Haskell-cafe] Re: Why is Day and Month bounded?
Chris Kuklewicz
haskell at list.mightyreason.com
Fri Jul 14 06:03:39 EDT 2006
Try this:
> module Cycle (Cyclic(..)) where
>
> import System.Time
> import Data.Word
> import Data.Int
>
> class (Eq c,Enum c, Bounded c) => Cyclic c where
> cyclePeriod :: c -> Int
> cyclePeriod _ = fromEnum (maxBound :: c) - fromEnum (minBound :: c) + 1
> succCycle :: c -> c
> succCycle c | c == maxBound = minBound
> | otherwise = succ c
> predCycle :: c-> c
> predCycle c | c == minBound = maxBound
> | otherwise = pred c
> fromCycle :: c -> Int
> fromCycle = fromEnum
> toCycle :: Int -> c
> toCycle = toEnum . (`mod` (cyclePeriod (undefined::c)))
> cycleFrom :: c -> [c]
> cycleFrom x = map toCycle [fromCycle x ..]
> cycleFromTo :: c -> c -> [c]
> cycleFromTo x y = let xi = fromCycle x
> yi = fromCycle y
> zi = if xi > yi then yi + cyclePeriod (undefined::c)
> else yi
> in map toCycle [xi .. zi]
> cycleFromThen :: c -> c -> [c]
> cycleFromThen x y = let xi = fromCycle x
> yi = fromCycle y
> in map toCycle [xi, yi ..]
> cycleFromThenTo :: c -> c -> c -> [c]
> cycleFromThenTo x y z = let
> c = cyclePeriod (undefined::c)
> xi = fromCycle x; yi = fromCycle y; zi = fromCycle z
> zi' = if xi <= yi
> then if yi <= zi
> then zi
> else zi + c
> else if zi <= yi
> then zi
> else zi - c
> in map toCycle [xi, yi .. zi']
>
> instance Cyclic Day
> instance Cyclic Month
> instance Cyclic Bool
> instance Cyclic ()
> instance Cyclic Ordering
> instance Cyclic Int
> instance Cyclic Char
> instance Cyclic Int8 -- Imported from GHC.Int
> instance Cyclic Int64 -- Imported from GHC.Int
> instance Cyclic Int32 -- Imported from GHC.Int
> instance Cyclic Int16 -- Imported from GHC.Int
> instance Cyclic Word8 -- Imported from GHC.Word
> instance Cyclic Word64 -- Imported from GHC.Word
> instance Cyclic Word32 -- Imported from GHC.Word
> instance Cyclic Word16 -- Imported from GHC.Word
More information about the Haskell-Cafe
mailing list