ISO8601.hs

-- © 2002 Peter Thiemann
module WASH.Utility.ISO8601 where

import Char
import Monad
import Time

import System.IO.Unsafe

import WASH.Utility.IntToString
import WASH.Utility.SimpleParser

secondsToString seconds =
  intToString 20 seconds

isoDateToString isoDate = 
  let seconds = unsafePerformIO $ isoDateToSeconds isoDate 
  in secondsToString seconds

isoDateAndTimeToString isoDateAndTime =
  let seconds = unsafePerformIO $ isoDateAndTimeToSeconds isoDateAndTime 
  in secondsToString seconds

applyToCalT :: (CalendarTime -> a) -> IO a
applyToCalT g =
  do clkT <- getClockTime
     calT <- toCalendarTime clkT
     return $ g calT

isoDateAndTimeToSeconds :: ISODateAndTime -> IO Integer
isoDateAndTimeToSeconds isoDateAndTime =
  applyToCalT $ toSeconds isoDateAndTime

isoTimeToSeconds :: ISOTime -> IO Integer
isoTimeToSeconds isoTime =
  applyToCalT $ toSeconds isoTime
  
isoDateToSeconds :: ISODate -> IO Integer
isoDateToSeconds isoDate =
  applyToCalT $ toSeconds isoDate

class ToSeconds iso where
  -- |returns number of seconds since reference point
  toSeconds :: iso -> CalendarTime -> Integer
  toRawSeconds :: iso -> CalendarTime -> Integer
  --
  toRawSeconds = toSeconds

instance ToSeconds ISODateAndTime where
  toSeconds isoDateAndTime@(ISODateAndTime isoDate isoTime) calT =
    let rawseconds = toRawSeconds isoDateAndTime calT in
    case addLeapSeconds leapSeconds rawseconds of
      NotLeapSecond seconds -> seconds
      LeapSecond seconds -> seconds + leapSecondCorrection isoTime

  toRawSeconds (ISODateAndTime isoDate isoTime) calT =
    toRawSeconds isoDate calT + toRawSeconds isoTime calT

-- |problem: 19720630T235960 and 19720701T000000 are both mapped to the same
-- number, 78796800, and then addLeapSeconds adds one yielding 78796801. While
-- this is correct for 19720701T000000, 19720630T235960 must be
-- 78796800. Implemented solution: if the current second specification is 0 and
-- the time to convert is the leap second, then add 1.
leapSecondCorrection (ISOTime isoHourSpec isoMinuteSpec isoSecondSpec isoTimeZoneSpec) =
  case isoSecondSpec of
    Second ss -> if ss == 0 then 1 else 0
    NoSecond  -> 1

instance ToSeconds ISODate where
  toSeconds isoDate calT =
    case addLeapSeconds leapSeconds (toRawSeconds isoDate calT) of
      NotLeapSecond seconds -> seconds
      LeapSecond seconds -> seconds + 1			    -- we always mean 00:00:00
	
  toRawSeconds (ISODate isoYearSpec isoDayOfYearSpec) calT =
    let year = isoYearSpecToYear isoYearSpec calT 
    in
    secondsPerDay * fromIntegral (yearsToDays year) +
    isoDaysOfYearToSeconds year isoDayOfYearSpec calT

isoDaysOfYearToSeconds year NoDayOfYear calT =
  0
isoDaysOfYearToSeconds year (MonthDay isoMonthSpec isoDayOfMonthSpec) calT =
  let month = isoMonthSpecToMonth isoMonthSpec calT
      dayOfMonth = isoDayOfMonthSpecToDayOfMonth isoDayOfMonthSpec calT
  in
  fromIntegral(dayOfMonth - 1 + daysUptoMonth year month) * secondsPerDay
isoDaysOfYearToSeconds year (DayOfYear ddd) calT =
  fromIntegral ddd * secondsPerDay
isoDaysOfYearToSeconds year (WeekAndDay (Week ww) NoDayOfWeek) calT =
  fromIntegral (7 * (ww - 1)) * secondsPerDay
isoDaysOfYearToSeconds year (WeekAndDay (Week ww) (DayOfWeek d)) calT =
  let weekdayOfJan1 = yearsToWeekDay year in
  fromIntegral (7 * (ww - 1) + d - weekdayOfJan1) * secondsPerDay
isoDaysOfYearToSeconds year (WeekAndDay ImplicitWeek (DayOfWeek d)) calT =
  let weekdayOfJan1 = yearsToWeekDay year 
      ww = (ctYDay calT + weekdayOfJan1 + 5) `div` 7 
  in
  fromIntegral (7 * (ww - 1) + d - weekdayOfJan1) * secondsPerDay
isoDaysOfYearToSeconds year (WeekAndDay _ _) calT =
  error "Sorry, this combination of week and day does not make sense!"

isoMonthSpecToMonth ImplicitMonth calT =
  fromEnum (ctMonth calT) + 1
isoMonthSpecToMonth (Month mm) calT =
  mm

isoDayOfMonthSpecToDayOfMonth NoDayOfMonth calT =
  1
isoDayOfMonthSpecToDayOfMonth (DayOfMonth dd) calT =
  dd

daysUptoMonth year month = 
  let daysPerMonth = [31, 28 + leapDays year, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] in
  sum (take (month-1) daysPerMonth)

isoYearSpecToYear ImplicitYear calT = 
  (ctYear calT)
isoYearSpecToYear (ImplicitCentury yy) calT =
  (100 * (ctYear calT `div` 100) + yy)
isoYearSpecToYear (Century cc) calT =
  (100 * cc)
isoYearSpecToYear (ImplicitDecade y) calT =
  (10 * (ctYear calT `div` 10) + y)
isoYearSpecToYear (Year ccyy) calT =
  ccyy

leapDays year =
  if leapYear year then 1 else 0

leapYear year =
  year `mod` 4 == 0 && (year `mod` 100 /= 0 || year `mod` 400 == 0)

yearsToDays ccyy =
  let nrOfYears = ccyy - 1970
      leapYears = [ year | year <- [1970 .. ccyy-1] , leapYear year ]
      nrOfLeapDays = length leapYears
  in 
  365 * nrOfYears + nrOfLeapDays

-- |compute weekday of Jan 1
yearsToWeekDay ccyy =
  let nrOfDays = yearsToDays ccyy
      jan_1_1970 = 4 -- Thursday
  in  1 + (nrOfDays + 6) `mod` 7

-- |in seconds from epoch; needs to be updated when time leaps again
leapSeconds :: [Integer]
leapSeconds = 
  [ -- Leap	1972	Jun	30	23:59:60	+	S
    00000000000078796800,
    -- Leap	1972	Dec	31	23:59:60	+	S
    00000000000094694400 + 1,
    -- Leap	1973	Dec	31	23:59:60	+	S
    00000000000126230400 + 2,
    -- Leap	1974	Dec	31	23:59:60	+	S
    00000000000157766400 + 3,
    -- Leap	1975	Dec	31	23:59:60	+	S
    00000000000189302400 + 4,
    -- Leap	1976	Dec	31	23:59:60	+	S
    00000000000220924800 + 5,
    -- Leap	1977	Dec	31	23:59:60	+	S
    00000000000252460800 + 6,
    -- Leap	1978	Dec	31	23:59:60	+	S
    00000000000283996800 + 7,
    -- Leap	1979	Dec	31	23:59:60	+	S
    00000000000315532800 + 8,
    -- Leap	1981	Jun	30	23:59:60	+	S
    00000000000362793600 + 9,
    -- Leap	1982	Jun	30	23:59:60	+	S
    00000000000394329600 + 10,
    -- Leap	1983	Jun	30	23:59:60	+	S
    00000000000425865600 + 11,
    -- Leap	1985	Jun	30	23:59:60	+	S
    00000000000489024000 + 12,
    -- Leap	1987	Dec	31	23:59:60	+	S
    00000000000567993600 + 13,
    -- Leap	1989	Dec	31	23:59:60	+	S
    00000000000631152000 + 14,
    -- Leap	1990	Dec	31	23:59:60	+	S
    00000000000662688000 + 15,
    -- Leap	1992	Jun	30	23:59:60	+	S
    00000000000709948800 + 16,
    -- Leap	1993	Jun	30	23:59:60	+	S
    00000000000741484800 + 17,
    -- Leap	1994	Jun	30	23:59:60	+	S
    00000000000773020800 + 18,
    -- Leap	1995	Dec	31	23:59:60	+	S
    00000000000820454400 + 19,
    -- Leap	1997	Jun	30	23:59:60	+	S
    00000000000867715200 + 20,
    -- Leap	1998	Dec	31	23:59:60	+	S
    00000000000915148800 + 21
  ]

data LeapSeconds = LeapSecond Integer | NotLeapSecond Integer
  deriving Show

addLeapSeconds [] seconds = NotLeapSecond seconds
addLeapSeconds (ls: rest) seconds =
  if ls > seconds then NotLeapSecond seconds else
  if ls == seconds then LeapSecond seconds else
  addLeapSeconds rest (seconds+1)
  
secondsPerMinute = 60
secondsPerHour = 60 * secondsPerMinute
secondsPerDay = 24 * secondsPerHour
secondsPerYear = 365 * secondsPerDay

instance ToSeconds ISOTime where
  -- seconds to 0:00 UTC
  -- may become negative to indicate previous day!
  toSeconds (ISOTime isoHourSpec isoMinuteSpec isoSecondSpec isoTimeZoneSpec) calT =
    toSeconds isoHourSpec calT +
    toSeconds isoMinuteSpec calT +
    toSeconds isoSecondSpec calT +
    toSeconds isoTimeZoneSpec calT
    
instance ToSeconds ISOHourSpec where
  toSeconds ImplicitHour calT = fromIntegral (3600 * ctHour calT - ctTZ calT)
  toSeconds (Hour hh) calT    = fromIntegral (3600 * hh - ctTZ calT)

instance ToSeconds ISOMinuteSpec where
  toSeconds ImplicitMinute calT = fromIntegral (60 * ctMin calT)
  toSeconds (Minute mm) calT = fromIntegral (60 * mm)
  toSeconds NoMinute calT = 0

instance ToSeconds ISOSecondSpec where
  toSeconds (Second ss) calT = fromIntegral ss
  toSeconds NoSecond calT = 0

instance ToSeconds ISOTimeZoneSpec where
  toSeconds LocalTime calT = 0
  toSeconds UTCTime calT = fromIntegral (ctTZ calT)
  toSeconds (PlusTime (Hour hh) isoMinuteSpec) calT = 
    fromIntegral (ctTZ calT - (3600 * hh + 60 * minutes isoMinuteSpec))
  toSeconds (MinusTime (Hour hh) isoMinuteSpec) calT =
    fromIntegral (ctTZ calT + (3600 * hh + 60 * minutes isoMinuteSpec))

minutes ImplicitMinute = 0
minutes (Minute mm) = mm
minutes NoMinute = 0

isoDateToClockTime :: ISODate -> ClockTime
isoDateToClockTime isoDate =
  let seconds = unsafePerformIO $ isoDateToSeconds isoDate 
  in secondsToClockTime seconds

isoDateAndTimeToClockTime :: ISODateAndTime -> ClockTime
isoDateAndTimeToClockTime isoDateAndTime =
  let seconds = unsafePerformIO $ isoDateAndTimeToSeconds isoDateAndTime 
  in secondsToClockTime seconds

secondsToClockTime seconds =
  let tdiff = TimeDiff { tdYear =0,
			 tdMonth =0,
			 tdDay =0,
			 tdHour =0,
			 tdMin =0,
			 tdSec = fromIntegral seconds,
			 tdPicosec =0
		       }
  in addToClockTime tdiff epochClkT
      
epochClkT = toClockTime epoch
epoch = CalendarTime {  ctYear   = 1970,
			ctMonth  = January,
			ctDay    = 1,
			ctHour   = 0,
			ctMin    = 0,
			ctSec    = 0,
			ctPicosec= 0,
			ctWDay   = Thursday,		    -- ignored
			ctYDay   = 0,			    -- ignored
			ctTZName = "UTC",		    -- ignored
			ctTZ     = 0,
			ctIsDST  = False		    -- ignored
		     }

    
-- |data type for representing ISO time
data ISODateAndTime =
  ISODateAndTime ISODate ISOTime
  deriving Show

data ISODate =
  ISODate ISOYearSpec ISODayOfYearSpec
  deriving Show

data ISOYearSpec
	= ImplicitYear | ImplicitCentury Int | Century Int | ImplicitDecade Int | Year Int
  deriving Show
data ISODayOfYearSpec
	= NoDayOfYear
	| MonthDay ISOMonthSpec ISODayOfMonthSpec
	| DayOfYear Int
	| WeekAndDay ISOWeekSpec ISODayOfWeekSpec
  deriving Show
data ISOMonthSpec
	= ImplicitMonth | Month Int
  deriving Show
data ISODayOfMonthSpec
	= NoDayOfMonth | DayOfMonth Int
  deriving Show
data ISOWeekSpec
	= ImplicitWeek | AnyWeek | Week Int
  deriving Show
data ISODayOfWeekSpec
	= NoDayOfWeek | DayOfWeek Int
  deriving Show
data ISOTime
	= ISOTime ISOHourSpec ISOMinuteSpec ISOSecondSpec ISOTimeZoneSpec
  deriving Show
data ISOHourSpec
	= ImplicitHour | Hour Int
  deriving Show
data ISOMinuteSpec
	= ImplicitMinute | Minute Int | NoMinute
  deriving Show
data ISOSecondSpec
	= Second Int | NoSecond
  deriving Show
data ISOTimeZoneSpec
	= LocalTime | UTCTime | PlusTime ISOHourSpec ISOMinuteSpec | MinusTime ISOHourSpec ISOMinuteSpec
  deriving Show

updateTZ (ISOTime isoHourSpec isoMinuteSpec isoSecondSpec _) isoTimeZoneSpec =
	ISOTime isoHourSpec isoMinuteSpec isoSecondSpec isoTimeZoneSpec

digitval = digitToInt

skipHyphen	= char '-' >> return ()
skipColon	= char ':' >> return ()
skipSolidus	= char '/' >> return ()
skipMinus	= char '-' >> return ()
skipPlus	= char '+' >> return ()
skipP		= oneOf "pP" >> return ()
skipT		= oneOf "tT" >> return ()
skipW		= oneOf "wW" >> return ()
skipZ		= oneOf "zZ" >> return ()

parseDateFromString :: String -> Maybe ISODate
parseDateFromString = parseFromString parseDate
parseTimeFromString :: String -> Maybe ISOTime
parseTimeFromString = parseFromString parseTime
parseDateAndTimeFromString :: String -> Maybe ISODateAndTime
parseDateAndTimeFromString = parseFromString parseDateAndTime

-- |external entry point
parseDate = 
  parseBasicOrExtended parseDateInternal

parseTime =
  parseBasicOrExtended parseTimeInternal

parseDateAndTime =
  parseBasicOrExtended parseTimeAndDateInternal

parseBasicOrExtended parser = 
  parser True <|> parser False

parseTimeAndDateInternal extended =
  do isodate <- parseDateInternal extended
     isotime <- option (ISOTime (Hour 0) NoMinute NoSecond UTCTime) 
                       (skipT >> parseTimeInternal extended)
     return $ ISODateAndTime isodate isotime

-- I was pretty much fed up with the irregular format of ISO 8601. After a few
-- tries, I decided that the simplest approach was to just list all the
-- alternatives from the standard.

-- |argument determines whether extended format is parsed
parseDateInternal False =
  -- 5.2.1.1, complete representation, basic format: CCYYMMDD
  (try $ do ccyy <- parseFourDigits
	    mm <- parseTwoDigits
	    dd <- parseTwoDigits
	    return $ ISODate (Year ccyy) $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- !!! CHECK THIS !!!
  -- 5.2.1.2.a, a specific month, basic format: CCYY-MM
  (try $ do ccyy <- parseFourDigits
	    skipHyphen
	    mm <- parseTwoDigits
	    return $ ISODate (Year ccyy) $ MonthDay (Month mm) NoDayOfMonth)
  <|>
  -- 5.2.1.2.b, a specific year, basic format: CCYY
  (try $ do ccyy <- parseFourDigits
	    return $ ISODate (Year ccyy) NoDayOfYear)
  <|>
  -- 5.2.1.2.c, a specific century, basic format: CC
  (try $ do cc <- parseTwoDigits
	    return $ ISODate (Century cc) NoDayOfYear)
  <|>
  -- 5.2.1.3.a, truncated representation, specific date in current century, basic format: YYMMDD
  (try $ do yy <- parseTwoDigits
	    mm <- parseTwoDigits
	    dd <- parseTwoDigits
	    return $ ISODate (ImplicitCentury yy) $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- 5.2.1.3.b, truncated representation, specific year and month in current century, basic format: -YYMM
  (try $ do skipHyphen
	    yy <- parseTwoDigits
	    mm <- parseTwoDigits
	    return $ ISODate (ImplicitCentury yy) $ MonthDay (Month mm) NoDayOfMonth)
  <|>
  -- 5.2.1.3.c, truncated representation, specific year in current century, basic format: -YY
  (try $ do skipHyphen
	    yy <- parseTwoDigits
	    return $ ISODate (ImplicitCentury yy) NoDayOfYear)
  <|>
  -- 5.2.1.3.d, truncated representation, specific day of a month, basic format: --MMDD
  (try $ do skipHyphen
	    skipHyphen
	    mm <- parseTwoDigits
	    dd <- parseTwoDigits
	    return $ ISODate ImplicitYear $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- 5.2.1.3.e, truncated representation, specific month, basic format: --MM
  (try $ do skipHyphen
	    skipHyphen
	    mm <- parseTwoDigits
	    return $ ISODate ImplicitYear $ MonthDay (Month mm) NoDayOfMonth)
  <|>
  -- 5.2.1.3.f, truncated representation, specific day, basic format: ---DD
  (try $ do skipHyphen
	    skipHyphen
	    skipHyphen
	    dd <- parseTwoDigits
	    return $ ISODate ImplicitYear $ MonthDay ImplicitMonth (DayOfMonth dd))
  <|>
  -- 5.2.2 Ordinal date
  -- 5.2.2.1, complete representation, basic format: CCYYDDD
  (try $ do ccyy <- parseFourDigits
	    ddd <- parseOrdinalDay
	    return $ ISODate (Year ccyy) $ DayOfYear ddd)
  <|>
  -- 5.2.2.2.a, truncated representation, specific year and day in current century, basic format: YYDDD
  (try $ do yy <- parseTwoDigits
	    ddd <- parseOrdinalDay
	    return $ ISODate (ImplicitCentury yy) $ DayOfYear ddd)
  <|>
  -- 5.2.2.2.b, truncated representation, specific day only, basic format: -DDD
  (try $ do skipHyphen
	    ddd <- parseOrdinalDay
	    return $ ISODate ImplicitYear $ DayOfYear ddd)
  <|>
  -- 5.2.3 date by calendar week and day number
  -- 5.2.3.1, complete representation, basic format: CCYYWwwD
  (try $ do ccyy <- parseFourDigits
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    d <- parseWeekDay
	    return $ ISODate (Year ccyy) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.2, reduced prec representation, basic format: CCYYWww
  (try $ do ccyy <- parseFourDigits
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    return $ ISODate (Year ccyy) $ WeekAndDay (Week ww) NoDayOfWeek)
  <|>
  -- 5.2.3.3.a, truncated representation, current century, basic format: YYWwwD
  (try $ do yy <- parseTwoDigits
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    d <- parseWeekDay
	    return $ ISODate (ImplicitCentury yy) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.3.b, truncated representation, current century, year and week only, basic format: YYWww
  (try $ do yy <- parseTwoDigits
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    return $ ISODate (ImplicitCentury yy) $ WeekAndDay (Week ww) NoDayOfWeek)
  <|>
  -- 5.2.3.3.c, truncated representation, current decade, week, and day, basic format: -YWwwD
  (try $ do skipHyphen
	    y <- parseOneDigit
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    d <- parseWeekDay
	    return $ ISODate (ImplicitDecade y) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.3.d, truncated representation, current year, week, and day, basic format: -WwwD
  (try $ do skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    d <- parseWeekDay
	    return $ ISODate ImplicitYear $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.3.e, truncated representation, current year, week only, basic format: -Www
  (try $ do skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    return $ ISODate ImplicitYear $ WeekAndDay (Week ww) NoDayOfWeek)
  <|>
  -- 5.2.3.3.f, truncated representation, day only of current week, basic format: -W-D
  (try $ do skipHyphen
	    skipW
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate ImplicitYear $ WeekAndDay ImplicitWeek (DayOfWeek d))
  <|>
  -- 5.2.3.3.g, truncated representation, day only of any week, basic format: ---D
  (try $ do skipHyphen
	    skipHyphen
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate ImplicitYear $ WeekAndDay AnyWeek (DayOfWeek d))


-- ----------------------------------------------------------------------
-- extended formats  
parseDateInternal True =
  -- 5.2.1.1, complete representation, extended format CCYY-MM-DD
  (try $ do ccyy <- parseFourDigits
	    skipHyphen
	    mm <- parseTwoDigits
	    skipHyphen
	    dd <- parseTwoDigits
	    return $ ISODate (Year ccyy) $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- 5.2.1.3.a, truncated representation, extended format: YY-MM-DD
  (try $ do yy <- parseTwoDigits
	    skipHyphen
	    mm <- parseTwoDigits
	    skipHyphen
	    dd <- parseTwoDigits
	    return $ ISODate (ImplicitCentury yy) $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- 5.2.1.3.b, truncated representation, specific year and month in current century, extended format: -YY-MM
  (try $ do skipHyphen
	    yy <- parseTwoDigits
	    skipHyphen
	    mm <- parseTwoDigits
	    return $ ISODate (ImplicitCentury yy) $ MonthDay (Month mm) NoDayOfMonth)
  <|>
  -- 5.2.1.3.d, truncated representation, specific day of a month, extended format: --MM-DD
  (try $ do skipHyphen
	    skipHyphen
	    mm <- parseTwoDigits
	    skipHyphen
	    dd <- parseTwoDigits
	    return $ ISODate ImplicitYear $ MonthDay (Month mm) (DayOfMonth dd))
  <|>
  -- 5.2.2 Ordinal date
  -- 5.2.2.1, complete representation, extended format: CCYY-DDD
  (try $ do ccyy <- parseFourDigits
	    skipHyphen
	    ddd <- parseOrdinalDay
	    return $ ISODate (Year ccyy) $ DayOfYear ddd)
  <|>
  -- 5.2.2.2.a, truncated representation, specific year and day in current century, extended format: YY-DDD
  (try $ do yy <- parseTwoDigits
	    skipHyphen
	    ddd <- parseOrdinalDay
	    return $ ISODate (ImplicitCentury yy) $ DayOfYear ddd)
  <|>
  -- 5.2.3 date by calendar week and day number
  -- 5.2.3.1, complete representation, extended format: CCYY-Www-D
  (try $ do ccyy <- parseFourDigits
	    skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate (Year ccyy) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.2, reduced prec representation, extended format: CCYY-Www
  (try $ do ccyy <- parseFourDigits
	    skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    return $ ISODate (Year ccyy) $ WeekAndDay (Week ww) NoDayOfWeek)
  <|>
  -- 5.2.3.3.a, truncated representation, current century, extended format: YY-Www-D
  (try $ do yy <- parseTwoDigits
	    skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate (ImplicitCentury yy) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- 5.2.3.3.b, truncated representation, current century, year and week only, extended format: YY-Www
  (try $ do yy <- parseTwoDigits
	    skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    return $ ISODate (ImplicitCentury yy) $ WeekAndDay (Week ww) NoDayOfWeek)
  <|>
  -- 5.2.3.3.c, truncated representation, current decade, week, and day, extended format: -Y-Www-D
  (try $ do skipHyphen
	    y <- parseOneDigit
	    skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate (ImplicitDecade y) $ WeekAndDay (Week ww) (DayOfWeek d))
  <|>
  -- !!! CHECK THIS
  -- 5.2.3.3.d, truncated representation, current year, week, and day, extended format: -Www-D
  (try $ do skipHyphen
	    skipW
	    ww <- parseTwoDigits
	    checkWeeks ww
	    skipHyphen
	    d <- parseWeekDay
	    return $ ISODate ImplicitYear $ WeekAndDay (Week ww) (DayOfWeek d))

-- |time parsers
parseTimeInternal extended =
  do localtime <- parseLocalTimeInternal extended
     tzsuffix  <- option LocalTime $ parseTZsuffix extended
     return $ updateTZ localtime tzsuffix

parseTZsuffix extended =
  (do skipZ 
      return UTCTime)
  <|>
  (do skipPlus
      (hours, minutes) <- parseHoursMinutes extended
      return $ PlusTime hours minutes)
  <|>
  (do skipMinus
      (hours, minutes) <- parseHoursMinutes extended
      return $ MinusTime hours minutes)

parseHoursMinutes False =
  do hh <- parseTwoDigits
     mm <- option NoMinute $ (liftM Minute) parseTwoDigits
     return (Hour hh, mm)

parseHoursMinutes True =
  do hh <- parseTwoDigits
     mm <- option NoMinute $ (liftM Minute) (skipColon >> parseTwoDigits)
     return (Hour hh, mm)

parseLocalTimeInternal False =
  -- 5.3.1.1, local time, basic format: hhmmss
  (try $ do hh <- parseTwoDigits
	    mm <- parseTwoDigits
	    ss <- parseTwoDigits
	    checkHours hh
	    checkMinutes mm
	    checkSeconds ss
	    return $ ISOTime (Hour hh) (Minute mm) (Second ss) LocalTime)
  <|>
  -- 5.3.1.2, local time, reduced precision, basic format: hhmm ; hh
  (try $ do hh <- parseTwoDigits
	    mm <- parseTwoDigits
	    checkHours hh
	    checkMinutes mm
	    return $ ISOTime (Hour hh) (Minute mm) NoSecond LocalTime)
  <|>
  (try $ do hh <- parseTwoDigits
	    checkHours hh
	    return $ ISOTime (Hour hh) NoMinute NoSecond LocalTime)
  <|>
  -- 5.3.1.4.a, local time, truncated, basic format: -mmss
  (try $ do skipHyphen
	    mm <- parseTwoDigits
	    ss <- parseTwoDigits
	    checkMinutes mm
	    checkSeconds ss
	    return $ ISOTime ImplicitHour (Minute mm) (Second ss) LocalTime)
  <|>
  -- 5.3.1.4.b, local time, truncated, basic format: -mm
  (try $ do skipHyphen
	    mm <- parseTwoDigits
	    checkMinutes mm
	    return $ ISOTime ImplicitHour (Minute mm) NoSecond LocalTime)
  <|>
  -- 5.3.1.4.c, local time, truncated, basic format: --ss
  (try $ do skipHyphen
	    skipHyphen
	    ss <- parseTwoDigits
	    checkSeconds ss
	    return $ ISOTime ImplicitHour ImplicitMinute (Second ss) LocalTime)
  

parseLocalTimeInternal True =
  -- 5.3.1.1, local time, extended format: hh:mm:ss
  (try $ do hh <- parseTwoDigits
	    skipColon
	    mm <- parseTwoDigits
	    skipColon
	    ss <- parseTwoDigits
	    checkHours hh
	    checkMinutes mm
	    checkSeconds ss
	    return $ ISOTime (Hour hh) (Minute mm) (Second ss) LocalTime)
  <|>
  -- 5.3.1.2, local time, reduced precision, extended format: hh:mm
  (try $ do hh <- parseTwoDigits
	    skipColon
	    mm <- parseTwoDigits
	    checkHours hh
	    checkMinutes mm
	    return $ ISOTime (Hour hh) (Minute mm) NoSecond LocalTime)
  <|>
  -- 5.3.1.4.a, local time, truncated, extended format: -mm:ss
  (try $ do skipHyphen
	    mm <- parseTwoDigits
	    skipColon
	    ss <- parseTwoDigits
	    checkMinutes mm
	    checkSeconds ss
	    return $ ISOTime ImplicitHour (Minute mm) (Second ss) LocalTime)

-- make ISOTime, ISODate, ISODateAndTime instances of Read
instance Read ISOTime where
  readsPrec i = parserToRead parseTime

instance Read ISODate where
  readsPrec i = parserToRead parseDate

instance Read ISODateAndTime where
  readsPrec i = parserToRead parseDateAndTime
-- auxiliary parsers

checkSeconds ss = if ss > 60 then fail "more than 60 seconds" else return ()
checkMinutes mm = if mm > 59 then fail "more than 59 minutes" else return ()
checkHours   hh = if hh > 24 then fail "more than 24 hours" else return ()
checkDays   ddd = if ddd < 1 || ddd > 366 then fail "illegal ordinal day" else return ()
checkWeeks   ww = if ww < 1 || ww > 53 then fail "illegal week nr" else return ()

parseWeekDay = do d0 <- oneOf "1234567"
		  return (digitval d0)

parseOneDigit = do d0 <- digit
		   return (digitval d0)
parseTwoDigits = do d1 <- digit
		    vv <- parseOneDigit
		    return (10 * digitval d1 + vv)
parseThreeDigits = do d2 <- digit
		      vv <- parseTwoDigits
		      let vvv = 100 * digitval d2 + vv
		      return vvv
parseOrdinalDay = do vvv <- parseThreeDigits
		     checkDays vvv
		     return vvv
parseFourDigits = do d3 <- digit
		     vvv <- parseThreeDigits
		     return (1000 * digitval d3 + vvv)