time since the epoch

Stefan Karrmann sk at mathematik.uni-ulm.de
Sat Nov 1 17:36:11 EST 2003


Hi,

a while ago time calculation was subject on this list.
Now, I have a time library based on the TAI (international
atomic time) time scale.

>Peter Thiemann (Thu, Feb 06, 2003 at 12:40:14PM -0800):
>> John's code illustrates TimeDiff's deficiencies perfectly:
>> 
>> There is also a more fundamental problem with the TimeDiff data
>> type. While seconds, minutes, hours, and days are clearly specified
>> amounts of time, the duration of a month or a year may vary depending
>> on the reference point where the time difference is applied.

> newtype TimeDiff = TimeDiff Rational
>    deriving (Eq, Ord)
>> Hmm, this is underspecified!
>> As another poster said, (pointing out http://cr.yp.to/libtai, but it
>> is better to look at http://cr.yp.to/time.html, which has a discussion
>> on UTC vs TAI vs UNIX time) the official source of time is TAI, so it
>> is best to base a time library
>> *on the number of TAI seconds since a reference date*
>> (which is btw what the libtai is all about).
>> For compatibility with UNIX time, "Arthur David Olson's popular time
>> library uses an epoch of 1970-01-01 00:00:10 TAI"
>> [http://cr.yp.to/proto/utctai.html]. 
>> So this mostly means that you need to set your system clock correctly:-)

Sincerly,
-- 
Stefan Karrmann
-------------- next part --------------
2003 Copyright (C) Stefan Karrmann <S.Karrmann at gmx.net>
All rights reserved.
The rights of the GNU Library General Public Licence Version 2
are granted, for details confer <http://www.fsf.org/copyleft/lgpl.html>.

This module provides data structures and functions to calculate with
Temps Atomique International (International Atomic Time, short TAI).
For further information about time see, e.g.
<http://www.boulder.nist.gov/timefreq/general/glossary3.htm>.

> module Main
> (
>   --main,
>   TAI(TAI)           -- Temps atomique international
>   ,TAIDiff(TAIDiff)
>   ,taidelta          -- TAI -> TAI -> TAIDiff
>   ,taimove           -- TAI -> TAIDiff -> TAI
>   ,taiadd            -- TAIDiff -> TAIDiff -> TAIDiff
>   ,taisub            -- TAIDiff -> TAIDiff -> TAIDiff
>   ,taimult           -- Rational -> TAIDiff -> TAIDiff
>   ,taipow            -- Integer  -> TAIDiff -> TAIDiff
>   ,tainegate         -- TAIDiff -> TAIDiff
>   ,tairecip          -- TAIDiff -> TAIDiff
>   ,unixEpoch         -- TAI
>   ,LeapSeconds(LeapSeconds)
>   ,emptyLeaps        -- LeapSeconds table valid until ISO 1970-01-01
>   ,leaps_2002_06_01  -- LeapSeconds table valid until ISO 2002-06-01
>   ,UTC(UTC)
>   ,tai2utc           -- LeapSeconds -> TAI -> UTC
>   ,utc2tai           -- UTC -> TAI
>   ,MJD(MJD)          -- Modified Julian Date
>   ,utc2mjd           -- UTC -> MJD
>   ,mjd2utc           -- MJD -> UTC
>   ,JD(JD)            -- Julian Date
>   ,mjd2jd            -- MJD -> JD
>   ,jd2mjd            -- JD  -> MJD
>   ,ISO
>   ,mjd2iso           -- MJD -> ISO
>   ,iso2mjd           -- ISO -> MJD
> )
> where
>
> import Prelude
> import List
> import Ratio

Values of TAIDiff contains (fractional) seconds without
a reference point.

> newtype TAIDiff = TAIDiff Rational
>                     deriving (Eq,Ord,Show,Read)

This belongs almost to the class Num, but multiplication
does not make sense - you would get square seconds. Thus,
we have to define our own functions until
class (UnitRing r, Group a)  => Modul a
enters Haskell.

> taidelta (TAI r1) (TAI r2) = TAIDiff (r1 - r2)
> taimove (TAI r1) (TAIDiff r2) = TAI (r1 + r2)
> taiadd (TAIDiff r1) (TAIDiff r2) = TAIDiff (r1 + r2)
> taisub (TAIDiff r1) (TAIDiff r2) = TAIDiff (r1 - r2)
> taimult r1 (TAIDiff r2) = TAIDiff (r1 * r2)
> taipow i (TAIDiff r) = TAIDiff (r ^^ i)
> tainegate (TAIDiff r) = TAIDiff (- r)
> tairecip (TAIDiff r) = TAIDiff (1/r)

Values of TAI are fixed points on the time axis of the eigentime
of the standardisation organisation in our space-time universe.

> newtype TAI = TAI Rational
>                     deriving (Eq,Ord,Show,Read)
> untai (TAI r) = r

The first defined TAI value - UNIX(TM) epoch, i.e.
Thursday ISO 1970-01-01T00:00:00

> unixEpoch = TAI 10
>   -- == ISO 1970 01 01 0 0 0 emptyLeaps
> libtaiEpoch = 4611686018427387914 -- 2^62 + 10

The leap second table data structure

> data LeapSeconds = LeapSeconds
>        TAI    {- valid until -}
>        [(TAI, {- when -}
>          Bool {- It is additional. -}
>        )]
>          deriving (Eq,Show,Read)

Valid leap second table for all times before unix epoch.

> emptyLeaps = LeapSeconds unixEpoch []

Up to date leap seconds can be found at some official sources:
<http://maia.usno.navy.mil/leapsec.html>
<http://hpiers.obspm.fr/webiers/general/earthor/utc/UTC.html>

> leaps_2002_06_01 =
>   let
>      valid = utc2tai $ mjd2utc $ iso2mjd $ ISO 2002 06 01 23 59 59 lst
>      lst@(LeapSeconds _ ls) =
>         h 1998 12 31 True
>         $ h 1997 06 30 True
>         $ h 1995 12 31 True
>         $ h 1994 06 30 True
>         $ h 1993 06 30 True
>         $ h 1992 06 30 True
>         $ h 1990 12 31 True
>         $ h 1989 12 31 True
>         $ h 1987 12 31 True
>         $ h 1985 06 30 True
>         $ h 1983 06 30 True
>         $ h 1982 06 30 True
>         $ h 1981 06 30 True
>         $ h 1979 12 31 True
>         $ h 1978 12 31 True
>         $ h 1977 12 31 True
>         $ h 1976 12 31 True
>         $ h 1975 12 31 True
>         $ h 1974 12 31 True
>         $ h 1973 12 31 True
>         $ h 1972 12 31 True
>         $ h 1972 06 30 True
>         emptyLeaps
>      h y m d add lst@(LeapSeconds v ls) =
>         let
>            lst' = LeapSeconds leap $ (leap,add):ls
>            leap = taimove (utc2tai $ mjd2utc $ iso2mjd $ ISO y m d 23 59 58 lst)
>                           (TAIDiff $ if add then 2 else 1)
>         in lst'
>    in LeapSeconds valid ls
>
> main = Prelude.print test0
>
> test = and [ True,
>   iso2mjd (ISO 2000 03 01 0 0 0 emptyLeaps)
>   == MJD (mjd_2000_03_01%1) False emptyLeaps,
>   iso2mjd (ISO 1970 01 01 0 0 0 emptyLeaps)
>   == utc2mjd (UTC 0 False emptyLeaps),
>   unixEpoch
>   == utc2tai (UTC 0 False emptyLeaps),
>   iso2mjd (ISO 1858 11 17 0 0 0 emptyLeaps)
>   == MJD 0 False emptyLeaps,
>   test0,
>   test2,
>   True]
>
> test0 =
>    let
>       utc = utc2tai
>       mjd = utc2tai . mjd2utc . utc2mjd
>       iso = utc2tai . mjd2utc . iso2mjd . mjd2iso . utc2mjd
>       jd  = utc2tai . mjd2utc . jd2mjd . mjd2jd . utc2mjd
>       witness       = map (TAI.(%1)) [-l..l]
>       mkwitness lst = map (tai2utc lst) witness
>       witnesses     = map mkwitness [emptyLeaps,leaps_2002_06_01]
>       l = seconds_per_day -- * days_per_400years * 7
>       testit idx f = and
>          $ map (uncurry(==))
>          $ zip witness
>          $ map f (witnesses!!idx)
>       testfkt idx =
>          and $ map (testit idx) [utc, mjd, iso, jd]
>     in
>       and $ map testfkt [0,1]
>
> test2 = null $ let
>            l = 366 * 100 -- I have checked 366*1000.
>            ls= [-l..l]
>            g (MJD d _ _) = fst $ properFraction d
>            f d = let
>               m = iso2mjd $ mjd2iso $ utc2mjd
>                   $ UTC ((d*seconds_per_day)%1) False emptyLeaps
>             in (mjd_1970_01_01+d,g m)
>          in filter (not . snd) $
>                ls `zip` (map (uncurry(==)) $ map f ls)
>


The UTC time scale with leap second information.

> data UTC = UTC
>         Rational {- UTC time (fractional) second -}
>         Bool     {- It is in a leap second -}
>         LeapSeconds
>            deriving (Show, Read)
>
> instance Eq UTC where
>    t1 == t2 = (utc2tai t1) == (utc2tai t2)
> 
> instance Ord UTC where
>    compare t1 t2 = compare (utc2tai t1) (utc2tai t2)

Now the conversion functions between UTC and TAI are given.

> tai2utc :: LeapSeconds -> TAI -> UTC
> tai2utc ls@(LeapSeconds valid leaps) t@(TAI r) =
>    if r < 0
>    then UTC (r-taisecondsEpoch%1) False ls
>    else let
>       relevant   = filter ((<= r) . untai . fst) leaps
>       isleap     = elem t (map fst relevant)
>       delta      = sum (map diff relevant)
>       diff (_,b) = if b then 1 else -1
>       u          = r + delta - taisecondsEpoch%1
>     in UTC u isleap ls
>
> utc2tai :: UTC -> TAI
> utc2tai (UTC u isleap ls@(LeapSeconds valid leaps)) =
>      if u <= 0
>      then TAI $ u + taisecondsEpoch%1
>      else let
>         t = u + taisecondsEpoch%1
>         sorted = sortBy cmp leaps
>         cmp a b = (fst a) `compare` (fst b)
>         acc u [] = u
>         acc u ((TAI l,f):ls) = if l > u
>                            then u
>                            else acc (u+ diff f) ls
>         diff b = if b then 1 else -1
>       in TAI $ acc t sorted

The next step is the convertion to a day calendar, we
use the modified julian date, MJD for short.
It is equal to the Julian date, but shifted so its
origin occurs at midnight on Wednesday 17 November 1858.

> data MJD = MJD
>               Rational
>               Bool {- It's in a leap second. -}
>               LeapSeconds
>                  deriving (Show,Read)
>
> instance Eq MJD where
>    t1 == t2 = (mjd2utc t1) == (mjd2utc t2)
> 
> instance Ord MJD where
>    compare t1 t2 = compare (mjd2utc t1) (mjd2utc t2)

Since MJD is synchronised with our sun we convert it to
UTC which is it, too.

> utc2mjd (UTC u isleap ls) =
>     MJD (mjd_1970_01_01%1 + u * (1%seconds_per_day)) isleap ls
>
> mjd_1970_01_01 = 40587
> mjd_2000_03_01 = 51604
> -- 2000-03-01 is MJD 51604
>
> mjd2utc (MJD d isleap ls) =
>     UTC ((d-mjd_1970_01_01%1) * (seconds_per_day%1)) isleap ls
>
> mjd_weekday (MJD d _ _) = (day + 3) `mod` 7
>    where
>       (day',frac) = properFraction d
>       day         = if frac > 0 then day' else day'-1


As a special service for astronoms we provide the julian date, too.

> data JD = JD Rational Bool LeapSeconds
>    deriving (Show,Read)
>
> mjd2jd (MJD d isleap leaps) = JD (d+jd_mjd0) isleap leaps
> jd2mjd (JD d isleap leaps) = MJD (d-jd_mjd0) isleap leaps
>
> jd_mjd0 = 2400000+1%2
> 
> instance Eq JD where
>    t1 == t2 = (jd2mjd t1) == (jd2mjd t2)
> 
> instance Ord JD where
>    compare t1 t2 = compare (jd2mjd t1) (jd2mjd t2)

Now we con introduce an ISO calendar with the common components
year, month, day, hour, minute and seconds.

> data ISO = ISO
>    Integer {- year -}
>    Integer {- month - 1..12 -}
>    Integer {- day - 1..28,29,30 or 31 -}
>    Integer {- hour - 0..23 -}
>    Integer {- minute - 0..59 -}
>    Rational {- second - [0;60) or [0;61) if leapsecond -}
>    LeapSeconds {- leap seconds table -}
>       deriving (Show,Read)
> 
> instance Eq ISO where
>    t1 == t2 = (iso2mjd t1) == (iso2mjd t2)
> 
> instance Ord ISO where
>    compare t1 t2 = compare (iso2mjd t1) (iso2mjd t2)

Some basic functions for ISO calendar dates, namely
`is it a leap year?' and `which day of the year is it?'.

> iso_isLeapYear (ISO y _ _ _ _ _ _) =
>       let
>          y400 = (y `mod` 400) == 0
>          y100 = (y `mod` 100) == 0
>          y4   = (y `mod` 4  ) == 0
>        in y400 || (y4 && not y100)
> 
> iso_yearday t@(ISO _ m d _ _ _ _) =
>       let
>          leapDay   = if iso_isLeapYear t then 1 else 0
>          -- Move march to zero but keep modulus positive.
>          (wrap,m') = (m-3+12) `divMod` 12
>          mday      = (m' * days_from_march + 5) `div` 10
>          mday'     = if wrap == 0
>                      then mday - days_from_march -- Befor march.
>                      else mday + days_per_year - days_from_march + leapDay
>        in mday' + fromIntegral d
>
> -- mjd2iso :: MJD -> ISO
> mjd2iso (MJD d isleap ls) =
>    let
>       -- Move origin to ISO 2003-03-01T00:00:00.
>       (days'',frac) = properFraction d
>       days'         = days''-mjd_2000_03_01
>       (daysec',secondfrac') = properFraction $ frac * (seconds_per_day%1)
>       secondfrac = if secondfrac' < 0 then 1 + secondfrac' else secondfrac'
>       daysec''   = if secondfrac' < 0 then daysec' - 1 else daysec'
>       daysec     = if daysec'' < 0 then seconds_per_day + daysec' else daysec'
>       days       = if daysec'' < 0 then days' - 1 else days'
>       hour       = fromInteger $ daysec `div` (seconds_per_minute * minutes_per_hour)
>       minute     = fromInteger $ (daysec `mod` (seconds_per_minute * minutes_per_hour))
>                    `div` seconds_per_minute
>       second'     = (daysec `mod` seconds_per_minute) + if isleap then 1 else 0
>       second      = secondfrac + second'%1
>       (y400,d400) = days `divMod` days_per_400years
>       (y100,d100) = if d400 == days_per_400years - 1
>                      then (3,days_per_century)
>                      else d400 `divMod` days_per_century
>       (y4,d4)     = d100 `divMod` days_per_4years
>       (y1,yday)   = if d4 == days_per_4years-1
>                     then (3,365)
>                     else d4 `divMod` days_per_year
>       ynext      = yday `div` days_from_march
>       year       = 400*y400+100*y100+4*y4+y1+ynext+2000
>       centiday   = yday * 10
>       cumulated_month_length_after_february = map ((`div` 10).(+5).(*306)) [1..12]
>       -- The div of the finite sequnces gives exactly the month, even july august.
>       (month',centiday') = (centiday + 5) `divMod` days_from_march
>       day'       = centiday' `div` 10
>       day        = fromInteger $ 1+ day'
>       month      = fromInteger $ 1+ if month' >= 10 then month'-10 else month'+2
>       wday       = (days'' + 3) `div` 7  -- MJD 0 _ _ is Wednesday.
>     in ISO year month day hour minute second ls
>

> iso2mjd (ISO year month day hour minute second ls) =
>    let
>       isleap = second >= 60%1
>       daysecond'  = ((hour * minutes_per_hour) + minute) * seconds_per_minute
>       daysecond   = second + (daysecond' + if isleap then -1 else 0)%1
>       (ym',month') = (month - 1 - 2 + 12) `divMod` 12 -- Force it positive.
>       ym     = 1 - ym'                              -- Switch month correction to year.
>       year2000   = year - 2000 - ym
>       (year400,y400) = year2000 `divMod` 400
>       (year100,y100) = y400 `divMod` 100
>       (year4,year1)  = y100 `divMod` 4
>       days'      = year400 * days_per_400years
>                    + year100 * days_per_century
>                    + year4   * days_per_4years
>                    + year1 * days_per_year
>       days''     = (month' * days_from_march + 5) `div` 10
>       cumulated_month_length_after_february = map ((`div` 10).(+5).(*306)) [1..12]
>       -- The div of the finite sequnces gives exactly the month, even july august.
>       days       = days' + day + days'' - 1
>       mjd        = (days + mjd_2000_03_01)%1 + daysecond * (1%seconds_per_day)
>     in MJD mjd isleap ls

Some local constants for iso calendar calculations.

> seconds_per_day = 86400
> days_per_year   = 365
> days_from_march = 306 -- = 365 - 31 - 28 (January & std. February)
> days_per_4years = days_per_year * 4 + 1 -- == 1461
> days_per_century = days_per_4years * 25 - 1 -- == 36524
> days_per_400years = days_per_century * 4 + 1 -- == 146097
> days_from_unixEpoch2MJD' = 11017 -- == 31 + 28 + 30 * 365 + 8
> days_from_MJD2unixEpoch = 53375995543064 -- ? (djbTaiEpoch - mjdTai)/seconds_per_day
> taisecondsEpoch = 10
> seconds_per_minute = 60
> minutes_per_hour = 60
> hours_per_day = 24
> month_per_year = 12

The component time diff to have an alternate calculation with
ISO calendars. Note that 7 days are always a week.

> data TimeDiff = TimeDiff
>    Integer  {- year   - reduces end of february to 28 as needed -}
>    Integer  {- month  - reduces end of month to 28,29 or 30 as needed -}
>    Integer  {- day    - reduces second below 59 as needed -}
>    Integer  {- hour   - reduces second below 59 as needed -}
>    Integer  {- minute - reduces second below 59 as needed -}
>    Rational {- second WITHOUT leap seconds, i.e. every minute has 60 seconds! -}
>
> -- instance Modul TimeDiff Integer where
>
> isodelta :: ISO -> ISO -> Maybe TimeDiff
> isodelta t t' =
>    if comparable
>    then Just $ TimeDiff (y-y') (m-m') (d-d') (h-h') (m-m') (s-s')
>    else Nothing
>       where
>          ISO y  mo  d  h  m  s  ls  = t
>          ISO y' mo' d' h' m' s' ls' = t'
>          LeapSeconds v _  = ls
>          LeapSeconds v' _ = ls'
>          vmin             = min v v'
>          iso2tai    = utc2tai . mjd2utc . iso2mjd
>          comparable = and $ map ((<= vmin).iso2tai) [t, t']

The ISO Calender has three groups of fields such that there is a
universal fixed ratio between the fields of each group. The groups
are:
(1) month and year
(2) minute, hour and day
(3) second

It is straight forward to move an ISO date in each group and adjust
the other two groups. But the moves and adjustments are not commutative,
so we have to separate moves of the different groups.

> isomoveYM (ISO y1 m1 d1 h1 mi1 s1 lst) (TimeDiff y2 m2 _ _ _ _) =
>    let
>       m3  = m1 - 1 + m2 + 12*(y1+y2)
>       (y,m')  = m3 `divMod` 12
>       m       = m'+1
>       d       = if m `elem` [1,3,5,7,8,10,12]
>                 then d
>                 else if m `elem` [4,6,9,11]
>                 then min d1 30
>                 else if iso_isLeapYear (ISO y 1 1 0 0 0 lst)
>                 then min d1 29
>                 else min d1 28
>       s        = if s1 < 59
>                  then s1
>                  else if mi2leap
>                  then min s1 60
>                  else if mi1leap
>                  then min s1 59
>                  else min s1 58
>       taileap1 = taimove (snd . cToTai $ (ISO y m d h1 mi1 58 lst))
>                          (TAIDiff 1)
>       mi1leap  = 59 == cSecond (cFromTai taileap1 lst)
>       taileap2 = taimove (snd . cToTai $ (ISO y m d h1 mi1 58 lst))
>                          (TAIDiff 2)
>       mi2leap  = 60 == cSecond (cFromTai taileap2 lst)
>     in ISO y m d h1 mi1 s lst

> isomoveDHM (ISO y1 m1 d1 h1 mi1 s1 lst) (TimeDiff _ _ d2 h2 mi2 _) =
>    let
>       mi3  = mi1 + mi2 + 60*(h1+h2 + 24*(d1-1+d2))
>       (h',mi) = mi3 `divMod` 60
>       (d',h)  = h'  `divMod` 24
>       MJD d3 _ _ = iso2mjd $ ISO y1 m1 1 0 0 0 emptyLeaps
>       ISO y m d _ _ _ _ = mjd2iso $ MJD (d3+(d'-1)%1) False emptyLeaps
>       s        = if s1 < 59
>                  then s1
>                  else if mi2leap
>                  then min s1 60
>                  else if mi1leap
>                  then min s1 59
>                  else min s1 58
>       taileap1 = taimove (snd . cToTai $ (ISO y m d h1 mi1 58 lst))
>                          (TAIDiff 1)
>       mi1leap  = 59 == cSecond (cFromTai taileap1 lst)
>       taileap2 = taimove (snd . cToTai $ (ISO y m d h1 mi1 58 lst))
>                          (TAIDiff 2)
>       mi2leap  = 60 == cSecond (cFromTai taileap2 lst)
>     in ISO y m d h1 mi1 s lst

> isomoveS (ISO y1 m1 d1 h1 mi1 s1 lst) (TimeDiff _ _ _ _ _ s2) =
>    let
>       MJD d3 _ _ = iso2mjd $ ISO y1 m1 d1 h1 mi1 s1 emptyLeaps
>       ISO y m d h mi s _ = mjd2iso $ MJD (d3+s2*1%seconds_per_day) False emptyLeaps
>     in ISO y m d h mi s lst

Now we can define a common calendar class with an instance
for all the upper calendar types but TAI.

> class Calendar a where
>    -- id == uncurry cFromTai . cToTai
>    cToTai    :: a -> (LeapSeconds, TAI)
>    cFromTai  :: LeapSeconds -> TAI -> a
>    cYear     :: a -> Integer
>    cMonth    :: a -> Integer
>    cMonthDay :: a -> Integer
>    cHour     :: a -> Integer
>    cMinute   :: a -> Integer
>    cSecond   :: a -> Rational
>    cIsLeapSecond :: a -> Bool
>    cIsLeapYear   :: a -> Bool
>    cWeekDay  :: a -> Integer
>    cYearDay  :: a -> Integer

> instance Calendar UTC where
>    cToTai u@(UTC _ _ lst) = (lst,utc2tai u)
>    cFromTai        = tai2utc
>    cYear t         = let ISO y _ _ _ _ _ _ = mjd2iso . utc2mjd $ t in y
>    cMonth t        = let ISO _ m _ _ _ _ _ = mjd2iso . utc2mjd $ t in m
>    cMonthDay t     = let ISO _ _ d _ _ _ _ = mjd2iso . utc2mjd $ t in d
>    cHour t         = let ISO _ _ _ h _ _ _ = mjd2iso . utc2mjd $ t in h
>    cMinute t       = let ISO _ _ _ _ m _ _ = mjd2iso . utc2mjd $ t in m
>    cSecond t       = let ISO _ _ _ _ _ s _ = mjd2iso . utc2mjd $ t in s
>    cIsLeapSecond (UTC _ isleap _) = isleap
>    cIsLeapYear     = iso_isLeapYear . mjd2iso . utc2mjd
>    cWeekDay        = mjd_weekday . utc2mjd
>    cYearDay        = iso_yearday . mjd2iso . utc2mjd

> instance Calendar MJD where
>    cToTai          = cToTai . mjd2utc
>    cFromTai lst t  = utc2mjd $ tai2utc lst t
>    cYear t         = let ISO y _ _ _ _ _ _ = mjd2iso t in y
>    cMonth t        = let ISO _ m _ _ _ _ _ = mjd2iso t in m
>    cMonthDay t     = let ISO _ _ d _ _ _ _ = mjd2iso t in d
>    cHour t         = let ISO _ _ _ h _ _ _ = mjd2iso t in h
>    cMinute t       = let ISO _ _ _ _ m _ _ = mjd2iso t in  m
>    cSecond t       = let ISO _ _ _ _ _ s _ = mjd2iso t in s
>    cIsLeapSecond (MJD _ isleap _) = isleap
>    cIsLeapYear     = iso_isLeapYear . mjd2iso
>    cWeekDay        = mjd_weekday
>    cYearDay        = iso_yearday . mjd2iso

> instance Calendar JD where
>    cToTai          = cToTai . jd2mjd
>    cFromTai lst t  = mjd2jd . utc2mjd $ tai2utc lst t
>    cYear t         = let ISO y _ _ _ _ _ _ = mjd2iso . jd2mjd $ t in y
>    cMonth t        = let ISO _ m _ _ _ _ _ = mjd2iso . jd2mjd $ t in  m
>    cMonthDay t     = let ISO _ _ d _ _ _ _ = mjd2iso . jd2mjd $ t in  d
>    cHour t         = let ISO _ _ _ h _ _ _ = mjd2iso . jd2mjd $ t in  h
>    cMinute t       = let ISO _ _ _ _ m _ _ = mjd2iso . jd2mjd $ t in  m
>    cSecond t       = let ISO _ _ _ _ _ s _ = mjd2iso . jd2mjd $ t in s
>    cIsLeapSecond (JD _ isleap _) = isleap
>    cIsLeapYear     = iso_isLeapYear . mjd2iso . jd2mjd
>    cWeekDay        = mjd_weekday . jd2mjd
>    cYearDay        = iso_yearday . mjd2iso . jd2mjd

> instance Calendar ISO where
>    cToTai          = cToTai . iso2mjd
>    cFromTai lst t  = mjd2iso . utc2mjd $ tai2utc lst t
>    cYear t         = let ISO y _ _ _ _ _ _ = t in y
>    cMonth t        = let ISO _ m _ _ _ _ _ = t in  m
>    cMonthDay t     = let ISO _ _ d _ _ _ _ = t in  d
>    cHour t         = let ISO _ _ _ h _ _ _ = t in  h
>    cMinute t       = let ISO _ _ _ _ m _ _ = t in  m
>    cSecond t       = let ISO _ _ _ _ _ s _ = t in s
>    cIsLeapSecond (ISO _ _ _ _ _ s _) = s >= 60
>    cIsLeapYear     = iso_isLeapYear
>    cWeekDay        = mjd_weekday . iso2mjd
>    cYearDay        = iso_yearday

It is open to implement the French Revolutionary Calendar,
the Maya Calender, the Chinese Calender, the Persian Calender,
the Hebrew Calender, the Islamic Calender, etc.
Cf.  <http://www.tondering.dk/claus/calendar.html>.


More information about the Haskell mailing list