module Data.Time.W3C.Parser.Parsec
    ( w3cDateTime
    )
    where

import Control.Monad
import Data.Time
import Data.Time.W3C.Types
import Text.Parsec


w3cDateTime :: Stream s m Char => ParsecT s u m W3CDateTime
w3cDateTime = read4 >>= mdhmst
    where
      mdhmst year
          = ( char '-' >> read2 >>= dhmst year )
            <|>
            return W3CDateTime {
                         w3cYear     = year
                       , w3cMonth    = Nothing
                       , w3cDay      = Nothing
                       , w3cHour     = Nothing
                       , w3cMinute   = Nothing
                       , w3cSecond   = Nothing
                       , w3cTimeZone = Nothing
                       }
      dhmst year month
          = ( char '-' >> read2 >>= hmst year month )
            <|>
            return W3CDateTime {
                         w3cYear     = year
                       , w3cMonth    = Just month
                       , w3cDay      = Nothing
                       , w3cHour     = Nothing
                       , w3cMinute   = Nothing
                       , w3cSecond   = Nothing
                       , w3cTimeZone = Nothing
                       }
      hmst year month day
          = ( do _ <- char 'T'
                 h <- read2
                 _ <- char ':'
                 m <- read2
                 st year month day h m
            )
            <|>
            return W3CDateTime {
                         w3cYear     = year
                       , w3cMonth    = Just month
                       , w3cDay      = Just day
                       , w3cHour     = Nothing
                       , w3cMinute   = Nothing
                       , w3cSecond   = Nothing
                       , w3cTimeZone = Nothing
                       }
      st year month day hour minute
          = ( do _ <- char ':'
                 s <- second
                 t <- timezone
                 return W3CDateTime {
                              w3cYear     = year
                            , w3cMonth    = Just month
                            , w3cDay      = Just day
                            , w3cHour     = Just hour
                            , w3cMinute   = Just minute
                            , w3cSecond   = Just s
                            , w3cTimeZone = Just t
                            }
            )
            <|>
            ( do t <- timezone
                 return W3CDateTime {
                              w3cYear     = year
                            , w3cMonth    = Just month
                            , w3cDay      = Just day
                            , w3cHour     = Just hour
                            , w3cMinute   = Just minute
                            , w3cSecond   = Nothing
                            , w3cTimeZone = Just t
                            }
            )

      second = do int  <- read2
                  frac <- option 0 (char '.' >> liftM parseFrac (many1 digit))
                  return (int + frac)

      timezone = liftM minutesToTimeZone
                 ( ( char 'Z' >> return 0 )
                   <|>
                   do sign <- ( char '+' >> return 1 )
                              <|>
                              ( char '-' >> return (-1) )
                      h    <- read2
                      _    <- char ':'
                      m    <- read2
                      return (sign * (h * 60 + m))
                 )

{- 0.152 => 2,5,1 -->
   * (0    / 10) + 0.2 = 0.2
   * (0.2  / 10) + 0.5 = 0.52
   * (0.52 / 10) + 0.1 = 0.152  *done*
 -}
parseFrac :: RealFrac r => String -> r
parseFrac = parseFrac' 0 . reverse . map fromC
    where
      parseFrac' r []     = r
      parseFrac' r (d:ds) = parseFrac' (r / 10 + d / 10) ds

read4 :: (Stream s m Char, Num n) => ParsecT s u m n
read4 = do n1 <- digit'
           n2 <- digit'
           n3 <- digit'
           n4 <- digit'
           return (n1 * 1000 + n2 * 100 + n3 * 10 + n4)

read2 :: (Stream s m Char, Num n) => ParsecT s u m n
read2 = do n1 <- digit'
           n2 <- digit'
           return (n1 * 10 + n2)

digit' :: (Stream s m Char, Num n) => ParsecT s u m n
digit' = liftM fromC digit

fromC :: Num n => Char -> n
fromC '0' = 0
fromC '1' = 1
fromC '2' = 2
fromC '3' = 3
fromC '4' = 4
fromC '5' = 5
fromC '6' = 6
fromC '7' = 7
fromC '8' = 8
fromC '9' = 9
fromC _   = undefined