module Data.Time.Clock.TAI.Parser (
   parseLeapSecondList
 , LeapSecondList(..)
 ) where

import Control.Applicative
import Control.Monad
import Data.Int
import Data.Maybe

import Text.Parser.Char
import Text.Parser.Combinators
import Text.Parser.Token
import Text.Trifecta.Delta
import Text.Trifecta.Parser
import Text.Trifecta.Result

import Data.Time

-- | Possible entries for the TAI leap-seconds file
data TAIEntry =
    TAILastUpdate Day
  | TAIExpiration Day
  | TAILeapSecond Day Int32
  | TAIHash String
  deriving (Eq, Ord, Show)

data LeapSecondList = LeapSecondList {
  expirationDate :: Day
, lastUpdate :: Day
, expectedHash :: String
, leapSeconds :: [(Day, Int32)]
} deriving (Eq, Ord, Show)

-- | Parse a leap second list
parseLeapSecondList :: String -> Either String LeapSecondList
parseLeapSecondList contents =
  case parseString parseTAIEntries (Columns 0 0) contents of
    (Failure parseError) -> Left $ show parseError
    (Success entries) -> buildLeapSecondList entries

-- | Build a leap second list from a list of TAIEntry. 
-- should add in checking of the hash
buildLeapSecondList :: [TAIEntry] -> Either String LeapSecondList
buildLeapSecondList list =
  LeapSecondList <$> expiration <*> updated <*> hash <*> leaps
  where
    expiration =
      single expirations "Too many expiration definitions\n"
    updated =
      single updates "Too many last update definitions\n"
    hash =
      single hashes "Too many hash definitions\n"
    leaps =
      return $ catMaybes $ getLeapSecond <$> list
    expirations =
      catMaybes $ getExpiration <$> list
    updates =
      catMaybes $ getLastUpdate <$> list
    hashes =
      catMaybes $ getHash <$> list
    single (x:[]) _ = Right x
    single _ e = Left e

getExpiration :: TAIEntry -> Maybe Day
getExpiration (TAIExpiration d) = Just d
getExpiration _ = Nothing

getLastUpdate :: TAIEntry -> Maybe Day
getLastUpdate (TAILastUpdate d) = Just d
getLastUpdate _ = Nothing

getLeapSecond :: TAIEntry -> Maybe (Day, Int32)
getLeapSecond (TAILeapSecond day dtai) = Just (day, dtai)
getLeapSecond _ = Nothing

getHash :: TAIEntry -> Maybe String
getHash (TAIHash h) = Just h
getHash _ = Nothing

eol :: Parser ()
eol = void $ char '\n'

parseTAIEntries :: Parser [TAIEntry]
parseTAIEntries =
  catMaybes <$> manyTill taiEntry eof
  where
    taiEntry =
          (Just <$> taiParser)
      <|> (const Nothing <$> parseComment)
    taiParser =
          (parseLeapSecond <?> "Leap second")
      <|> (parseLastUpdate <?> "Last update")
      <|> (parseExpiration <?> "Expiration")
      <|> (parseTAIHash <?> "Hash")

consumeLine :: Parser ()
consumeLine = do
  _<- spaces
  (parseComment <|> eol)

parseComment :: Parser ()
parseComment = void $ do
  _<- char '#'
  _<- manyTill anyChar eol
  return ()

parseLastUpdate :: Parser TAIEntry
parseLastUpdate = do
  _<- string "#$"
  _<- spaces
  lastUpdateNtp <- natural <?> "Last Update"
  _<- spaces
  return . TAILastUpdate $ ntpToDay lastUpdateNtp

parseExpiration :: Parser TAIEntry
parseExpiration = do
  _<- string "#@"
  _<- spaces
  expiration <- natural <?> "Expiration date"
  _<- spaces
  return . TAIExpiration $ ntpToDay expiration

parseLeapSecond :: Parser TAIEntry
parseLeapSecond = do
  time <- natural <?> "Leap second time"
  _<- spaces
  dtai <- natural <?> "dtai"
  _<- consumeLine
  return $ TAILeapSecond (ntpToDay time) $ fromIntegral dtai

parseTAIHash :: Parser TAIEntry
parseTAIHash = do
  _<- string "#h"
  _<- spaces
  hash <- manyTill anyChar eol <?> "Hash"
  return $ TAIHash hash

ntpToDay :: Integer -> Day
ntpToDay n = addDays (div n 86400) ntpEpochDay

ntpEpochDay :: Day
ntpEpochDay = ModifiedJulianDay 15020