Data/Time/W3C/Types.hs

   1 module Data.Time.W3C.Types
   2     ( W3CDateTime(..)
   3     )
   4     where
   5
   6 import Data.Convertible
   7 import Data.Fixed
   8 import Data.Time
   9 import Data.Typeable
  10
  11
  12 -- This data type is /partially ordered/ so we can't make it an
  13 -- instance of Ord (e.g. "2010" and "2010-01" can't be compared).
  14 data W3CDateTime
  15     = W3CDateTime {
  16         w3cYear     :: !Integer
  17       , w3cMonth    :: !(Maybe Int)
  18       , w3cDay      :: !(Maybe Int)
  19       , w3cHour     :: !(Maybe Int)
  20       , w3cMinute   :: !(Maybe Int)
  21       , w3cSecond   :: !(Maybe Pico)
  22       , w3cTimeZone :: !(Maybe TimeZone)
  23       }
  24     deriving (Show, Eq, Typeable)
  25
  26 fetch :: (Show a, Typeable a, Typeable b) =>
  27          String
  28       -> (a -> Maybe b)
  29       -> a
  30       -> ConvertResult b
  31 fetch name f a
  32     = case f a of
  33         Nothing -> convError ("No " ++ name ++ " information in the given value") a
  34         Just b  -> return b
  35
  36 instance Convertible Day W3CDateTime where
  37     safeConvert day
  38         = case toGregorian day of
  39             (y, m, d) -> return W3CDateTime {
  40                                        w3cYear     = y
  41                                      , w3cMonth    = Just m
  42                                      , w3cDay      = Just d
  43                                      , w3cHour     = Nothing
  44                                      , w3cMinute   = Nothing
  45                                      , w3cSecond   = Nothing
  46                                      , w3cTimeZone = Nothing
  47                                      }
  48
  49 instance Convertible W3CDateTime Day where
  50     safeConvert w3c
  51         = do let y = w3cYear w3c
  52              m <- fetch "month" w3cMonth w3c
  53              d <- fetch "day"   w3cDay   w3c
  54              return (fromGregorian y m d)
  55
  56 instance Convertible ZonedTime W3CDateTime where
  57     safeConvert zt
  58         = let lt  = zonedTimeToLocalTime zt
  59               tz  = zonedTimeZone zt
  60               ymd = localDay lt
  61               hms = localTimeOfDay lt
  62           in
  63             return W3CDateTime {
  64                          w3cYear     =       case toGregorian ymd of (y, _, _) -> y
  65                        , w3cMonth    = Just (case toGregorian ymd of (_, m, _) -> m)
  66                        , w3cDay      = Just (case toGregorian ymd of (_, _, d) -> d)
  67                        , w3cHour     = Just (todHour hms)
  68                        , w3cMinute   = Just (todMin  hms)
  69                        , w3cSecond   = Just (todSec  hms)
  70                        , w3cTimeZone = Just tz
  71                        }
  72
  73 instance Convertible W3CDateTime ZonedTime where
  74     safeConvert w3c
  75         = do day <- safeConvert w3c
  76              tod <- do h   <- fetch "hour"   w3cHour   w3c
  77                        m   <- fetch "minute" w3cMinute w3c
  78                        s   <- fetch "second" w3cSecond w3c
  79                        case makeTimeOfDayValid h m s of
  80                          Just tod -> return tod
  81                          Nothing  -> convError "Invalid time of day" w3c
  82              tz  <- fetch "timezone" w3cTimeZone w3c
  83              return ZonedTime {
  84                           zonedTimeToLocalTime = LocalTime day tod
  85                         , zonedTimeZone        = tz
  86                         }