From: PHO Date: Thu, 11 Mar 2010 06:33:54 +0000 (+0900) Subject: Renamed package name: w3cdatetime -> time-w3c X-Git-Tag: RELEASE-0.1.0.1~13 X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-w3c.git;a=commitdiff_plain;h=6d5883f6e0a22b39d1e5614afd8ba6595e46a464 Renamed package name: w3cdatetime -> time-w3c --- diff --git a/Data/Time/W3CDateTime.hs b/Data/Time/W3CDateTime.hs index 5505474..b1c1230 100644 --- a/Data/Time/W3CDateTime.hs +++ b/Data/Time/W3CDateTime.hs @@ -1,82 +1,6 @@ module Data.Time.W3CDateTime - ( W3CDateTime + ( W3CDateTime(..) ) where -import Data.Convertible -import Data.Fixed -import Data.Time -import Data.Typeable - - --- 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) - -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 - } - -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 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 UTCTime W3CDateTime where - safeConvert u - = let (y, m, d) = toGregorian (utctDay u) - hms = timeToTimeOfDay (utctDayTime u) - in - return W3CDateTime { - w3cYear = y - , w3cMonth = Just m - , w3cDay = Just d - , w3cHour = Just (todHour hms) - , w3cMinute = Just (todMin hms) - , w3cSecond = Just (todSec hms) - , w3cTimeZone = Just utc - } - -instance Convertible W3CDateTime UTCTime 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 - let lt = LocalTime day tod - return (localTimeToUTC tz lt) +import Data.Time.W3CDateTime.Types diff --git a/Data/Time/W3CDateTime/Types.hs b/Data/Time/W3CDateTime/Types.hs new file mode 100644 index 0000000..b41023c --- /dev/null +++ b/Data/Time/W3CDateTime/Types.hs @@ -0,0 +1,82 @@ +module Data.Time.W3CDateTime.Types + ( W3CDateTime(..) + ) + where + +import Data.Convertible +import Data.Fixed +import Data.Time +import Data.Typeable + + +-- 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) + +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 + } + +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 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 UTCTime W3CDateTime where + safeConvert u + = let (y, m, d) = toGregorian (utctDay u) + hms = timeToTimeOfDay (utctDayTime u) + in + return W3CDateTime { + w3cYear = y + , w3cMonth = Just m + , w3cDay = Just d + , w3cHour = Just (todHour hms) + , w3cMinute = Just (todMin hms) + , w3cSecond = Just (todSec hms) + , w3cTimeZone = Just utc + } + +instance Convertible W3CDateTime UTCTime 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 + let lt = LocalTime day tod + return (localTimeToUTC tz lt) diff --git a/w3cdatetime.cabal b/time-w3c.cabal similarity index 84% rename from w3cdatetime.cabal rename to time-w3c.cabal index 1308ccd..96a224a 100644 --- a/w3cdatetime.cabal +++ b/time-w3c.cabal @@ -1,6 +1,6 @@ -Name: w3cdatetime +Name: time-w3c Version: 0.1 -Synopsis: Parse and format W3C Date and Time +Synopsis: Parse, format and convert W3C Date and Time -- A longer description of the package. -- Description: @@ -19,6 +19,7 @@ Extra-source-files: Library Exposed-modules: Data.Time.W3CDateTime + Data.Time.W3CDateTime.Types Build-depends: base >= 4 && < 5,