[Haskell-cafe] Re: Why is Day and Month bounded?
Chris Kuklewicz
haskell at list.mightyreason.com
Fri Jul 14 06:35:01 EDT 2006
Okay...final version attached.
This one fixes the toCycle bugs and changes from Int to Integer so overflow is
no longer an issue.
The result of cycleFromThenTo fits what I would expect, but you are free to drop
this or adapt it.
cycleFrom and cycleFromTo and cycleFromThen are easy, since there is no
difference between ascending and descending. Note that the returned list is
never null.
cycleFromThenTo can be either ascending or descending depending on the first two
arguments, and it considers the first occurrence of the third argument in that
direction of the cycle starting from the initial argument:
*Cycle> cycleFromThenTo Monday Wednesday Tuesday
[Monday]
instead of
> *Cycle> cycleFromThenTo Monday Wednesday Tuesday
> [Monday,Wednesday,Friday,Sunday,Tuesday]
This agrees with things like [1,3 .. 2] returning [1] and [3,1 .. 2] returning [3].
-------------- next part --------------
{- By Chris Kuklewicz <haskell at list.mightyreason.com>
3 Clause BSD license, copyright 2006
-}
module Cycle (Cyclic(..)) where
import System.Time
import Data.Word
import Data.Int
default ()
class (Eq c,Enum c, Bounded c) => Cyclic c where
cyclePeriod :: c -> Integer
cyclePeriod _ = fromCycle (maxBound :: c)
- fromCycle (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 -> Integer
fromCycle = toInteger . fromEnum
toCycle :: Integer -> c
toCycle = toEnum
. fromInteger
. (+ (fromCycle (minBound::c)))
. (`mod` (cyclePeriod (undefined::c)))
. (subtract (fromCycle (minBound::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 xi <= zi
then zi
else zi + c
else if zi <= xi
then zi
else zi - c
in map toCycle [xi, yi .. zi']
instance Cyclic ()
instance Cyclic Bool
instance Cyclic Ordering
instance Cyclic Int
instance Cyclic Char
instance Cyclic Day -- Imported from System.Time
instance Cyclic Month -- Imported from System.Time
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