content: {-# OPTIONS -fno-warn-unused-imports #-}
  #include "HsConfigure.h"
  -- | TAI and leap-second tables for converting to UTC: most people won't need this module.
  module Data.Time.Clock.TAI
  (
  	-- TAI arithmetic
  	AbsoluteTime,taiEpoch,addAbsoluteTime,diffAbsoluteTime,
  
  	-- leap-second table type
  	LeapSecondTable,
  
  	-- conversion between UTC and TAI with table
  	utcDayLength,utcToTAITime,taiToUTCTime,
  
  	parseTAIUTCDATFile
  ) where
  
  import Data.Time.LocalTime
  import Data.Time.Calendar.Days
  import Data.Time.Clock
  import Control.DeepSeq
  import Data.Typeable
  import Data.Fixed
  #if LANGUAGE_Rank2Types
  import Data.Data
  #endif
  
  -- | AbsoluteTime is TAI, time as measured by a clock.
  newtype AbsoluteTime = MkAbsoluteTime {unAbsoluteTime :: DiffTime} deriving (Eq,Ord
  #if LANGUAGE_DeriveDataTypeable
  #if LANGUAGE_Rank2Types
  #if HAS_DataPico
      ,Data, Typeable
  #endif
  #endif
  #endif
      )
  
  instance NFData AbsoluteTime where
  	rnf (MkAbsoluteTime a) = rnf a
  
  instance Show AbsoluteTime where
  	show t = show (utcToLocalTime utc (taiToUTCTime (const 0) t)) ++ " TAI" -- ugly, but standard apparently
  
  -- | The epoch of TAI, which is 1858-11-17 00:00:00 TAI.
  taiEpoch :: AbsoluteTime
  taiEpoch = MkAbsoluteTime 0
  
  -- | addAbsoluteTime a b = a + b
  addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime
  addAbsoluteTime t (MkAbsoluteTime a) = MkAbsoluteTime (a + t)
  
  -- | diffAbsoluteTime a b = a - b
  diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime
  diffAbsoluteTime (MkAbsoluteTime a) (MkAbsoluteTime b) = a - b
  
  -- | TAI - UTC during this day.
  -- No table is provided, as any program compiled with it would become
  -- out of date in six months.
  type LeapSecondTable = Day -> Integer
  
  utcDayLength :: LeapSecondTable -> Day -> DiffTime
  utcDayLength table day = realToFrac (86400 + (table (addDays 1 day)) - (table day))
  
  dayStart :: LeapSecondTable -> Day -> AbsoluteTime
  dayStart table day = MkAbsoluteTime	(realToFrac ((toModifiedJulianDay day) * 86400 + (table day)))
  
  utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime
  utcToTAITime table (UTCTime day dtime) = MkAbsoluteTime (t + dtime) where
  	MkAbsoluteTime t = dayStart table day
  
  taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime
  taiToUTCTime table abstime = stable (ModifiedJulianDay (div' (unAbsoluteTime abstime) 86400)) where
  	stable day = if (day == day') then UTCTime day dtime else stable day' where
  		dayt = dayStart table day
  		dtime = diffAbsoluteTime abstime dayt
  		day' = addDays (div' dtime (utcDayLength table day)) day
  
  -- | Parse the contents of a tai-utc.dat file.
  -- This does not do any kind of validation and will return a bad table for input
  -- not in the correct format.
  parseTAIUTCDATFile :: String -> LeapSecondTable
  parseTAIUTCDATFile ss = offsetlist 0 (parse (lines ss)) where
  	offsetlist :: Integer -> [(Day,Integer)] -> LeapSecondTable
  	offsetlist i [] _ = i
  	offsetlist i ((d0,_):_) d | d < d0 = i
  	offsetlist _ ((_,i0):xx) d = offsetlist i0 xx d
  	
  	parse :: [String] -> [(Day,Integer)]
  	parse [] = []
  	parse (a:as) = let
  		ps = parse as
  	 in case matchLine a of
  		Just di -> di:ps
  		Nothing -> ps
  	
  	matchLine :: String -> Maybe (Day,Integer)
  	matchLine s = do
  		check0S s
  		(d,s') <- findJD s
  		i <- findOffset s'
  		return (d,i)
  	
  	-- a bit fragile
  	check0S :: String -> Maybe ()
  	check0S "X 0.0      S" = Just ()
  	check0S [] = Nothing
  	check0S (_:cs) = check0S cs
  	
  	findJD :: String -> Maybe (Day,String)
  	findJD ('=':'J':'D':s) = do
  		d <- getInteger '5' s
  		return (ModifiedJulianDay (d - 2400000),s)
  	findJD [] = Nothing
  	findJD (_:cs) = findJD cs
  	
  	findOffset :: String -> Maybe Integer
  	findOffset ('T':'A':'I':'-':'U':'T':'C':'=':s) = getInteger '0' s
  	findOffset [] = Nothing
  	findOffset (_:cs) = findOffset cs
  	
  	getInteger :: Char -> String -> Maybe Integer
  	getInteger p s = do
  		digits <- getDigits p s
  		fromDigits 0 digits
  	
  	getDigits :: Char -> String -> Maybe String
  	getDigits p (' ':s) = getDigits p s
  	getDigits p (c:cs) | c >= '0' && c <= '9' = do
  		s <- getDigits p cs
  		return (c:s)
  	getDigits p ('.':p1:_) = if p == p1 then Just [] else Nothing
  	getDigits _ _ = Nothing
  		
  	
  	fromDigits :: Integer -> String -> Maybe Integer
  	fromDigits i [] = Just i
  	fromDigits i (c:cs) | c >= '0' && c <= '9' = fromDigits ((i * 10) + (fromIntegral ((fromEnum c) - (fromEnum '0')))) cs
  	fromDigits _ _ = Nothing
  
  -- typical line format:
  -- 1972 JAN  1 =JD 2441317.5  TAI-UTC=  10.0       S + (MJD - 41317.) X 0.0      S
  -- 1972 JUL  1 =JD 2441499.5  TAI-UTC=  11.0       S + (MJD - 41317.) X 0.0      S
  