Data/Time/W3C/Types.hs

   1 -- | Data types defined by this package.
   2 module Data.Time.W3C.Types
   3     ( W3CDateTime(..)
   4     )
   5     where
   6
   7 import Data.Convertible
   8 import Data.Fixed
   9 import Data.Time
  10 import Data.Typeable
  11
  12
  13 -- |'W3CDateTime' represents a W3C Date and Time format.
  14 --
  15 -- The field 'w3cYear' is mandatory while other fields are
  16 -- optional. But you should be careful about combinations of such
  17 -- optional fields. No combinations are allowed except for the
  18 -- following list:
  19 --
  20 --   * YYYY
  21 --
  22 --   * YYYY-MM
  23 --
  24 --   * YYYY-MM-DD
  25 --
  26 --   * YYYY-MM-DDThh:mmTZD
  27 --
  28 --   * YYYY-MM-DDThh:mm:ss.sTZD
  29 --
  30 -- This data type is /partially ordered/ so we can't make it an
  31 -- instance of Ord (e.g. @\"2010\"@ and @\"2010-01\"@ can't be
  32 -- compared).
  33 data W3CDateTime
  34     = W3CDateTime {
  35         w3cYear     :: !Integer
  36       , w3cMonth    :: !(Maybe Int)
  37       , w3cDay      :: !(Maybe Int)
  38       , w3cHour     :: !(Maybe Int)
  39       , w3cMinute   :: !(Maybe Int)
  40       , w3cSecond   :: !(Maybe Pico)
  41       , w3cTimeZone :: !(Maybe TimeZone)
  42       }
  43     deriving (Show, Eq, Typeable)
  44
  45 fetch :: (Show a, Typeable a, Typeable b) =>
  46          String
  47       -> (a -> Maybe b)
  48       -> a
  49       -> ConvertResult b
  50 fetch name f a
  51     = case f a of
  52         Nothing -> convError ("No " ++ name ++ " information in the given value") a
  53         Just b  -> return b
  54
  55 instance Convertible W3CDateTime W3CDateTime where
  56     safeConvert = return
  57
  58 instance Convertible Day W3CDateTime where
  59     safeConvert day
  60         = case toGregorian day of
  61             (y, m, d) -> return W3CDateTime {
  62                                        w3cYear     = y
  63                                      , w3cMonth    = Just m
  64                                      , w3cDay      = Just d
  65                                      , w3cHour     = Nothing
  66                                      , w3cMinute   = Nothing
  67                                      , w3cSecond   = Nothing
  68                                      , w3cTimeZone = Nothing
  69                                      }
  70
  71 instance Convertible W3CDateTime Day where
  72     safeConvert w3c
  73         = do let y = w3cYear w3c
  74              m <- fetch "month" w3cMonth w3c
  75              d <- fetch "day"   w3cDay   w3c
  76              return (fromGregorian y m d)
  77
  78 instance Convertible ZonedTime W3CDateTime where
  79     safeConvert zt
  80         = let lt  = zonedTimeToLocalTime zt
  81               tz  = zonedTimeZone zt
  82               ymd = localDay lt
  83               hms = localTimeOfDay lt
  84           in
  85             return W3CDateTime {
  86                          w3cYear     =       case toGregorian ymd of (y, _, _) -> y
  87                        , w3cMonth    = Just (case toGregorian ymd of (_, m, _) -> m)
  88                        , w3cDay      = Just (case toGregorian ymd of (_, _, d) -> d)
  89                        , w3cHour     = Just (todHour hms)
  90                        , w3cMinute   = Just (todMin  hms)
  91                        , w3cSecond   = Just (todSec  hms)
  92                        , w3cTimeZone = Just tz
  93                        }
  94
  95 instance Convertible W3CDateTime ZonedTime where
  96     safeConvert w3c
  97         = do day <- safeConvert w3c
  98              tod <- do h   <- fetch "hour"   w3cHour   w3c
  99                        m   <- fetch "minute" w3cMinute w3c
 100                        s   <- fetch "second" w3cSecond w3c
 101                        case makeTimeOfDayValid h m s of
 102                          Just tod -> return tod
 103                          Nothing  -> convError "Invalid time of day" w3c
 104              tz  <- fetch "timezone" w3cTimeZone w3c
 105              return ZonedTime {
 106                           zonedTimeToLocalTime = LocalTime day tod
 107                         , zonedTimeZone        = tz
 108                         }