-- | Data types defined by this package.
module Data.Time.W3C.Types
    ( W3CDateTime(..)
    )
    where

import Data.Convertible
import Data.Fixed
import Data.Time
import Data.Typeable


-- |'W3CDateTime' represents a W3C Date and Time format.
--
-- The field 'w3cYear' is mandatory while other fields are
-- optional. But you should be careful about combinations of such
-- optional fields. No combinations are allowed except for the
-- following list:
--
--   * YYYY
--
--   * YYYY-MM
--
--   * YYYY-MM-DD
--
--   * YYYY-MM-DDThh:mmTZD
--
--   * YYYY-MM-DDThh:mm:ss.sTZD
--
-- This data type is /partially ordered/ so we can't make it an
-- instance of Ord (e.g. @\"2010\"@ and @\"2010-01\"@ can't be
-- compared).
data W3CDateTime
    = W3CDateTime {
        w3cYear     :: !Integer
      , w3cMonth    :: !(Maybe Int)
      , w3cDay      :: !(Maybe Int)
      , w3cHour     :: !(Maybe Int)
      , w3cMinute   :: !(Maybe Int)
      , w3cSecond   :: !(Maybe Pico)
      , w3cTimeZone :: !(Maybe TimeZone)
      }
    deriving (Show, Eq, Typeable)

fetch :: (Show a, Typeable a, Typeable b) =>
         String
      -> (a -> Maybe b)
      -> a
      -> ConvertResult b
fetch name f a
    = case f a of
        Nothing -> convError ("No " ++ name ++ " information in the given value") a
        Just b  -> return b

instance Convertible W3CDateTime W3CDateTime where
    safeConvert = return

instance Convertible Day W3CDateTime where
    safeConvert day
        = case toGregorian day of
            (y, m, d) -> return W3CDateTime {
                                       w3cYear     = y
                                     , w3cMonth    = Just m
                                     , w3cDay      = Just d
                                     , w3cHour     = Nothing
                                     , w3cMinute   = Nothing
                                     , w3cSecond   = Nothing
                                     , w3cTimeZone = Nothing
                                     }

instance Convertible W3CDateTime Day where
    safeConvert w3c
        = do let y = w3cYear w3c
             m <- fetch "month" w3cMonth w3c
             d <- fetch "day"   w3cDay   w3c
             return (fromGregorian y m d)

instance Convertible ZonedTime W3CDateTime where
    safeConvert zt
        = let lt  = zonedTimeToLocalTime zt
              tz  = zonedTimeZone zt
              ymd = localDay lt
              hms = localTimeOfDay lt
          in
            return W3CDateTime {
                         w3cYear     =       case toGregorian ymd of (y, _, _) -> y
                       , w3cMonth    = Just (case toGregorian ymd of (_, m, _) -> m)
                       , w3cDay      = Just (case toGregorian ymd of (_, _, d) -> d)
                       , w3cHour     = Just (todHour hms)
                       , w3cMinute   = Just (todMin  hms)
                       , w3cSecond   = Just (todSec  hms)
                       , w3cTimeZone = Just tz
                       }

instance Convertible W3CDateTime ZonedTime where
    safeConvert w3c
        = do day <- safeConvert w3c
             tod <- do h   <- fetch "hour"   w3cHour   w3c
                       m   <- fetch "minute" w3cMinute w3c
                       s   <- fetch "second" w3cSecond w3c
                       case makeTimeOfDayValid h m s of
                         Just tod -> return tod
                         Nothing  -> convError "Invalid time of day" w3c
             tz  <- fetch "timezone" w3cTimeZone w3c
             return ZonedTime {
                          zonedTimeToLocalTime = LocalTime day tod
                        , zonedTimeZone        = tz
                        }