time-w3c (empty) → 0.1
raw patch · 12 files changed
+654/−0 lines, 12 filesdep +HUnitdep +basedep +convertiblesetup-changed
Dependencies added: HUnit, base, convertible, parsec, time
Files
- COPYING +29/−0
- Data/Time/W3C.hs +16/−0
- Data/Time/W3C/Format.hs +85/−0
- Data/Time/W3C/Parser.hs +24/−0
- Data/Time/W3C/Parser/Parsec.hs +137/−0
- Data/Time/W3C/Types.hs +108/−0
- Setup.hs +9/−0
- tests/ConversionTest.hs +45/−0
- tests/FormatterTest.hs +35/−0
- tests/ParsecParserTest.hs +76/−0
- tests/W3CDateTimeUnitTest.hs +13/−0
- time-w3c.cabal +77/−0
+ COPYING view
@@ -0,0 +1,29 @@+<!-- -*- xml -*-++w3cdatetime はパブリックドメインに在ります。+w3cdatetime is in the public domain.++See http://creativecommons.org/licenses/publicdomain/++-->++<rdf:RDF xmlns="http://web.resource.org/cc/"+ xmlns:dc="http://purl.org/dc/elements/1.1/"+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#">+ <Work rdf:about="http://cielonegro.org/W3CDateTime.html">+ <dc:title>w3cdatetime</dc:title>+ <dc:rights>+ <Agent>+ <dc:title>PHO</dc:title>+ </Agent>+ </dc:rights>+ <license rdf:resource="http://web.resource.org/cc/PublicDomain" />+ </Work>++ <License rdf:about="http://web.resource.org/cc/PublicDomain">+ <permits rdf:resource="http://web.resource.org/cc/Reproduction" />+ <permits rdf:resource="http://web.resource.org/cc/Distribution" />+ <permits rdf:resource="http://web.resource.org/cc/DerivativeWorks" />+ </License>++</rdf:RDF>
+ Data/Time/W3C.hs view
@@ -0,0 +1,16 @@+-- | This package provides functionalities to parse and format W3C+-- Date and Time. The package can also be used to convert it from/to+-- 'Data.Time.Calendar.Day' and 'Data.Time.LocalTime.ZonedTime'.+--+-- See: <http://www.w3.org/TR/NOTE-datetime>++module Data.Time.W3C+ ( W3CDateTime(..)+ , format+ , parse+ )+ where++import Data.Time.W3C.Format+import Data.Time.W3C.Parser+import Data.Time.W3C.Types
+ Data/Time/W3C/Format.hs view
@@ -0,0 +1,85 @@+-- | Format W3C Date and Time strings.+module Data.Time.W3C.Format+ ( format+ )+ where++import Data.Convertible+import Data.Fixed+import Data.Time+import Data.Time.W3C.Types+++-- | Format W3C Date and Time string from anything convertible to+-- 'W3CDateTime' type. The most obvious acceptable type is the+-- 'W3CDateTime' itself.+format :: Convertible t W3CDateTime => t -> String+format = format' . convert+ where+ format' (W3CDateTime year Nothing Nothing Nothing Nothing Nothing Nothing)+ = show4 year++ format' (W3CDateTime year (Just month) Nothing Nothing Nothing Nothing Nothing)+ = concat [show4 year, "-", show2 month]++ format' (W3CDateTime year (Just month) (Just day) Nothing Nothing Nothing Nothing)+ = concat [show4 year, "-", show2 month, "-", show2 day]++ format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) Nothing (Just tz))+ = concat [ show4 year+ , "-"+ , show2 month+ , "-"+ , show2 day+ , "T"+ , show2 hour+ , ":"+ , show2 minute+ , showTZ tz+ ]++ format' (W3CDateTime year (Just month) (Just day) (Just hour) (Just minute) (Just second) (Just tz))+ = concat [ show4 year+ , "-"+ , show2 month+ , "-"+ , show2 day+ , "T"+ , show2 hour+ , ":"+ , show2 minute+ , ":"+ , case properFraction second :: (Int, Pico) of+ (int, 0 ) -> show2 int+ (int, frac) -> show2 int ++ tail (showFixed True frac)+ , showTZ tz+ ]++ format' w = error ("Invalid W3C Date and Time: " ++ show w)++show4 :: Integral i => i -> String+show4 i+ | i >= 0 && i < 10 = "000" ++ show i+ | i >= 0 && i < 100 = "00" ++ show i+ | i >= 0 && i < 1000 = "0" ++ show i+ | i >= 0 && i < 10000 = show i+ | otherwise = error ("show4: the integer i must satisfy 0 <= i < 10000: " ++ show i)++show2 :: Integral i => i -> String+show2 i+ | i >= 0 && i < 10 = "0" ++ show i+ | i >= 0 && i < 100 = show i+ | otherwise = error ("show2: the integer i must satisfy 0 <= i < 100: " ++ show i)++showTZ :: TimeZone -> String+showTZ tz+ = case timeZoneMinutes tz of+ offset | offset < 0 -> '-' : showTZ' (negate offset)+ | offset == 0 -> "Z"+ | otherwise -> '+' : showTZ' offset+ where+ showTZ' offset+ = let h = offset `div` 60+ m = offset - h * 60+ in+ concat [show2 h, ":", show2 m]
+ Data/Time/W3C/Parser.hs view
@@ -0,0 +1,24 @@+-- | Parse W3C Date and Time string.+module Data.Time.W3C.Parser+ ( parse+ )+ where++import qualified Text.Parsec as P++import Data.Convertible+import Data.Time.W3C.Parser.Parsec+import Data.Time.W3C.Types++-- | Parse W3C Date and Time string to anything convertible from+-- 'W3CDateTime' type. The most obvious acceptable type is the+-- 'W3CDateTime' itself. If the given string is ill-formatted, 'parse'+-- returns 'Prelude.Nothing'.+parse :: Convertible W3CDateTime t => String -> Maybe t+parse src = case P.parse p "" src of+ Right w3c -> Just (convert w3c)+ Left _ -> Nothing+ where+ p = do w3c <- w3cDateTime+ _ <- P.eof+ return w3c
+ Data/Time/W3C/Parser/Parsec.hs view
@@ -0,0 +1,137 @@+-- | W3C Date and Time parser combinator for "Text.Parsec".+module Data.Time.W3C.Parser.Parsec+ ( w3cDateTime+ )+ where++import Control.Monad+import Data.Time+import Data.Time.W3C.Types+import Text.Parsec++-- | This is a parser combinator for "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
+ Data/Time/W3C/Types.hs view
@@ -0,0 +1,108 @@+-- | 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+ }
+ Setup.hs view
@@ -0,0 +1,9 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+import System.Cmd+import System.Exit++main = defaultMainWithHooks (simpleUserHooks { runTests = runTestUnit })+ where+ runTestUnit _ _ _ _+ = system "./dist/build/W3CDateTimeUnitTest/W3CDateTimeUnitTest" >> return ()
+ tests/ConversionTest.hs view
@@ -0,0 +1,45 @@+module ConversionTest+ ( testData+ )+ where++import Data.Convertible+import Data.Time+import Data.Time.W3C+import Test.HUnit+++instance Eq ZonedTime where+ a == b+ = zonedTimeToUTC a == zonedTimeToUTC b+++testData :: [Test]+testData = [ convert (W3CDateTime 2010 (Just 1) (Just 2) Nothing Nothing Nothing Nothing)+ ~?=+ fromGregorian 2010 1 2++ , convert (W3CDateTime 2010 (Just 1) (Just 2) (Just 3) (Just 4) (Just 5.666666) (Just utc))+ ~?=+ ZonedTime {+ zonedTimeToLocalTime = let day = fromGregorian 2010 1 2+ tod = TimeOfDay 3 4 5.666666+ in+ LocalTime day tod+ , zonedTimeZone = utc+ }++ , convert (fromGregorian 2010 1 2)+ ~?=+ W3CDateTime 2010 (Just 1) (Just 2) Nothing Nothing Nothing Nothing++ , convert ZonedTime {+ zonedTimeToLocalTime = let day = fromGregorian 2010 1 2+ tod = TimeOfDay 3 4 5.666666+ in+ LocalTime day tod+ , zonedTimeZone = utc+ }+ ~?=+ W3CDateTime 2010 (Just 1) (Just 2) (Just 3) (Just 4) (Just 5.666666) (Just utc)+ ]
+ tests/FormatterTest.hs view
@@ -0,0 +1,35 @@+module FormatterTest+ ( testData+ )+ where++import Data.Time+import Data.Time.W3C+import Test.HUnit+++testData :: [Test]+testData = [ format (W3CDateTime 2010 Nothing Nothing Nothing Nothing Nothing Nothing)+ ~?=+ "2010"++ , format (W3CDateTime 2010 (Just 12) Nothing Nothing Nothing Nothing Nothing)+ ~?=+ "2010-12"++ , format (W3CDateTime 2010 (Just 12) (Just 31) Nothing Nothing Nothing Nothing)+ ~?=+ "2010-12-31"++ , format (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) Nothing (Just utc))+ ~?=+ "2010-12-31T01:23Z"++ , format (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) (Just 45) (Just (hoursToTimeZone 9)))+ ~?=+ "2010-12-31T01:23:45+09:00"++ , format (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) (Just 45.666666) (Just (hoursToTimeZone 9)))+ ~?=+ "2010-12-31T01:23:45.666666+09:00"+ ]
+ tests/ParsecParserTest.hs view
@@ -0,0 +1,76 @@+module ParsecParserTest+ ( testData+ )+ where++import Data.Time+import Data.Time.W3C hiding (parse)+import Data.Time.W3C.Parser.Parsec+import Test.HUnit+import Text.Parsec+++parseW3C :: String -> Either String W3CDateTime+parseW3C src = case parse w3cDateTime "" src of+ Left err -> Left (show err)+ Right w3c -> Right w3c++parseW3C' :: String -> Maybe W3CDateTime+parseW3C' src = case parse w3cDateTime "" src of+ Left _ -> Nothing+ Right w3c -> Just w3c+++testData :: [Test]+testData = [ parseW3C "2010"+ ~?=+ Right (W3CDateTime 2010 Nothing Nothing Nothing Nothing Nothing Nothing)++ , parseW3C "2010-12"+ ~?=+ Right (W3CDateTime 2010 (Just 12) Nothing Nothing Nothing Nothing Nothing)++ , parseW3C "2010-12-31"+ ~?=+ Right (W3CDateTime 2010 (Just 12) (Just 31) Nothing Nothing Nothing Nothing)++ , parseW3C "2010-12-31T01:23Z"+ ~?=+ Right (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) Nothing (Just (hoursToTimeZone 0)))++ , parseW3C "2010-12-31T01:23:45+09:00"+ ~?=+ Right (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) (Just 45) (Just (hoursToTimeZone 9)))++ , parseW3C "2010-12-31T01:23:45.666666+09:00"+ ~?=+ Right (W3CDateTime 2010 (Just 12) (Just 31) (Just 1) (Just 23) (Just 45.666666) (Just (hoursToTimeZone 9)))++ , parseW3C' ""+ ~?=+ Nothing++ , parseW3C' "99-01-01"+ ~?=+ Nothing++ , parseW3C' "2010-01-01T"+ ~?=+ Nothing++ , parseW3C' "2010-01-01T10Z"+ ~?=+ Nothing++ , parseW3C' "2010-01-01T11:22"+ ~?=+ Nothing++ , parseW3C' "2010-01-01T11:22:33"+ ~?=+ Nothing++ , parseW3C' "2010-01-01T11:22:33.Z"+ ~?=+ Nothing+ ]
+ tests/W3CDateTimeUnitTest.hs view
@@ -0,0 +1,13 @@+import Test.HUnit+import qualified ConversionTest+import qualified FormatterTest+import qualified ParsecParserTest++main :: IO ()+main = do runTestTT (test testData) >> return ()++testData :: [Test]+testData = [ "conversion" ~: ConversionTest.testData+ , "parser" ~: ParsecParserTest.testData+ , "formatter" ~: FormatterTest.testData+ ]
+ time-w3c.cabal view
@@ -0,0 +1,77 @@+Name: time-w3c+Version: 0.1+Synopsis: Parse, format and convert W3C Date and Time+Description:+ This package provides functionalities to parse and format W3C+ Date and Time. The package can also be used to convert it+ from/to 'Data.Time.Calendar.Day' and+ 'Data.Time.LocalTime.ZonedTime'.++ See: <http://www.w3.org/TR/NOTE-datetime>++License: PublicDomain+License-file: COPYING+Author: PHO <pho AT cielonegro DOT org>+Maintainer: PHO <pho AT cielonegro DOT org>+Stability: Experimental+Homepage: http://cielonegro.org/W3CDateTime.html+Category: Web+Build-type: Simple+Cabal-version: >= 1.6+Extra-source-files:++Source-Repository head+ Type: git+ Location: git://git.cielonegro.org/time-w3c.git++Flag build-test-suite+ Description: Build the tst suite.+ Default: False++Library+ Exposed-modules:+ Data.Time.W3C+ Data.Time.W3C.Format+ Data.Time.W3C.Parser+ Data.Time.W3C.Parser.Parsec+ Data.Time.W3C.Types++ Build-depends:+ base >= 4 && < 5,+ convertible >= 1.0 && < 2,+ parsec >= 3 && < 4,+ time >= 1.1 && < 2++ Extensions:+ DeriveDataTypeable+ FlexibleContexts+ MultiParamTypeClasses++ GHC-Options:+ -Wall++Executable W3CDateTimeUnitTest+ Main-Is:+ W3CDateTimeUnitTest.hs++ if flag(build-test-suite)+ Buildable: True+ Build-Depends: HUnit >= 1.2 && < 2+ else+ Buildable: False++ Hs-Source-Dirs:+ ., tests++ Other-Modules:+ ConversionTest+ FormatterTest+ ParsecParserTest++ Extensions:+ DeriveDataTypeable+ FlexibleContexts+ MultiParamTypeClasses++ GHC-Options:+ -Wall