diff --git a/Data/Time/RFC2822.hs b/Data/Time/RFC2822.hs --- a/Data/Time/RFC2822.hs +++ b/Data/Time/RFC2822.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-} --- | +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +-- | -- Module : Data.Time.RFC2822 -- Copyright : (c) 2011 Hugo Daniel Gomes -- @@ -8,15 +10,15 @@ -- Stability : experimental -- Portability : GHC -- --- Support for reading and displaying time in the format specified by +-- Support for reading and displaying time in the format specified by -- the RFC2822 section 3.3 -- -- Example of usage: --- > +-- -- > import Data.Time.LocalTime -- > --- > showTime :: IO String --- > showTime = getZonedTime >>= return . showRFC2822 +-- > showTime :: IO Text +-- > showTime = getZonedTime >>= return . formatTimeRFC2822 -- > -- > example1 = "Fri, 21 Nov 1997 09:55:06 -0600" -- > example2 = "Tue, 15 Nov 1994 12:45:26 GMT" @@ -28,25 +30,29 @@ -- > example8 = "24 Nov 1997 14:22:01 -0800" -- > examples = [example1,example2,example3,example4,example5,example6,example7,example8] -- > --- > readAll = map readRFC2822 examples +-- > readAll = map parseTimeRFC2822 examples module Data.Time.RFC2822 ( -- * Basic type class -- $basic - RFC2822(showRFC2822, readRFC2822) + formatTimeRFC2822, parseTimeRFC2822 ) where -#if __GLASGOW_HASKELL__ < 710 -import System.Locale -#endif +import Control.Applicative -import Data.Time.Format -import Data.Time.LocalTime -import Data.Time.Calendar -import Data.Maybe -import qualified Data.Attoparsec.Text as A -import Data.Attoparsec.Text import qualified Data.Attoparsec.Combinator as AC +import Data.Attoparsec.Text +import qualified Data.Attoparsec.Text as A +import Data.Maybe +import Data.Monoid ((<>)) +import Data.Monoid.Textual hiding (foldr, map) +import Data.String (fromString) +import Data.Text (Text) +import Data.Time.Calendar +import Data.Time.Format +import Data.Time.Locale.Compat +import Data.Time.LocalTime +import Data.Time.Util test1 = "Fri, 21 Nov 1997 09:55:06 -0600" test2 = "Tue, 15 Nov 1994 12:45:26 GMT" @@ -60,55 +66,37 @@ test10 = "Mon,24 Nov 1997 14:22:01 -0800" test11 = "Thu,\t13\n Feb\n 1969\n 23:32\n -0330 (Newfoundland Time)" -- Fails test12 = "Thu, 13 Feb 1969 23:32 -0330 (Newfoundland Time)" -- Fails -tests :: [String] +tests :: [Text] tests = [test1, test2, test3, test4, test5, test6, test7, test8, test9, test10 , test11, test12] -testParse = length (catMaybes (map readRFC2822 tests)) == length tests +testParse = length (catMaybes (map parseTimeRFC2822 tests)) == length tests --- ---------------------------------------------------------------------------- --- The RFC2822 class definition --- | This class is here to allow future support for other data types --- like Data.Text or Data.ByteString if that becomes necessary -class RFC2822 a where - showRFC2822 :: ZonedTime -> a - readRFC2822 :: a -> Maybe ZonedTime - formatRFC2822 :: [a] - --- | For now there is only an instance for the String data type -instance RFC2822 String where - showRFC2822 zt@(ZonedTime lt z) = - formatTime defaultTimeLocale "%a, %e %b %Y %T" zt ++ printZone - where - timeZoneStr = timeZoneOffsetString z - printZone = if timeZoneStr == timeZoneOffsetString utc +formatTimeRFC2822 :: (TextualMonoid t) => ZonedTime -> t +formatTimeRFC2822 zt@(ZonedTime lt z) = fromString (formatTime defaultTimeLocale "%a, %e %b %Y %T" zt) <> fromString printZone + where timeZoneStr = timeZoneOffsetString z + printZone = if timeZoneStr == timeZoneOffsetString utc then " GMT" else " " ++ timeZoneStr - formatRFC2822 = [ "%a, %e %b %Y %T GMT" - , "%a, %e %b %Y %T %z" - , "%e %b %Y %T GMT" - , "%e %b %Y %T %z" - -- Support for hours:minutes - , "%a, %e %b %Y %R GMT" - , "%a, %e %b %Y %R %z" - , "%e %b %Y %R GMT" - , "%e %b %Y %R %z" - ] - - readRFC2822 t = foldr (tryP t') Nothing $ map p formatRFC2822 - where - p :: String -> String -> Maybe ZonedTime - p f s = parseTime defaultTimeLocale f s - - tryP :: String -> (String -> Maybe a) -> Maybe a -> Maybe a - tryP s f acc | isJust acc = acc - | otherwise = f s +formatsRFC2822 :: [Text] +formatsRFC2822 = [ "%a, %e %b %Y %T GMT" + , "%a, %e %b %Y %T %z" + , "%e %b %Y %T GMT" + , "%e %b %Y %T %z" + -- Support for hours:minutes + , "%a, %e %b %Y %R GMT" + , "%a, %e %b %Y %R %z" + , "%e %b %Y %R GMT" + , "%e %b %Y %R %z" + ] - -- t' is a trimmed t (currently only \n is trimmed) - -- TODO: trim other white space characters - t' :: String - t' = lines t >>= ("" ++) +parseTimeRFC2822 :: (TextualMonoid t) => t -> Maybe ZonedTime +parseTimeRFC2822 t = foldr (<|>) Nothing $ map parse formatsRFC2822 + where parse :: (TextualMonoid t) => t -> Maybe ZonedTime + parse format = parseTime defaultTimeLocale (toString format) t' -showTime :: IO String -showTime = getZonedTime >>= return . showRFC2822 + -- t' is a trimmed t (currently only \n is trimmed) + -- TODO: trim other white space characters + t' :: String + t' = lines (toString t) >>= ("" ++) diff --git a/Data/Time/RFC3339.hs b/Data/Time/RFC3339.hs --- a/Data/Time/RFC3339.hs +++ b/Data/Time/RFC3339.hs @@ -1,5 +1,7 @@ -{-# LANGUAGE CPP, TypeSynonymInstances, FlexibleInstances #-} --- | +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +-- | -- Module : Data.Time.RFC3339 -- Copyright : (c) 2011 Hugo Daniel Gomes -- @@ -8,15 +10,15 @@ -- Stability : experimental -- Portability : GHC -- --- Support for reading and displaying time in the format specified by +-- Support for reading and displaying time in the format specified by -- the RFC3339 -- -- Example of usage: --- > +-- -- > import Data.Time.LocalTime -- > --- > showTime :: IO String --- > showTime = getZonedTime >>= return . showRFC3339 +-- > showTime :: IO Text +-- > showTime = formatTimeRFC3339 <$> getZonedTime -- > -- > example1 = "1985-04-12T23:20:50.52Z" -- > example2 = "1996-12-19T16:39:57-08:00" @@ -25,64 +27,51 @@ -- > example5 = "1937-01-01T12:00:27.87+00:20" -- > examples = [example1,example2,example3,example4,example5] -- > --- > readAll = map readRFC3339 examples +-- > readAll = map parseTimeRFC3339 examples module Data.Time.RFC3339 ( -- * Basic type class -- $basic - RFC3339(showRFC3339, readRFC3339) + formatTimeRFC3339, parseTimeRFC3339 ) where -#if __GLASGOW_HASKELL__ < 710 -import System.Locale -#endif +import Control.Applicative -import Data.Time.Format -import Data.Time.LocalTime -import Data.Time.Calendar -import Data.Maybe +import Data.Maybe +import Data.Monoid ((<>)) +import Data.Monoid.Textual hiding (foldr, map) +import Data.String (fromString) +import Data.Text (Text) +import Data.Time.Calendar +import Data.Time.Format +import Data.Time.Locale.Compat +import Data.Time.LocalTime +import Data.Time.Util + test1 = "1985-04-12T23:20:50.52Z" test2 = "1996-12-19T16:39:57-08:00" test3 = "1990-12-31T23:59:60Z" test4 = "1990-12-31T15:59:60-08:00" test5 = "1937-01-01T12:00:27.87+00:20" -tests :: [String] +tests :: [Text] tests = [test1, test2, test3, test4, test5] -testParse = length (catMaybes (map readRFC3339 tests)) == length tests +testParse = length (catMaybes (map parseTimeRFC3339 tests)) == length tests --- ---------------------------------------------------------------------------- --- The RFC3339 class definition --- | This class is here to allow future support for other data types --- like Data.Text or Data.ByteString if that becomes necessary -class RFC3339 a where - showRFC3339 :: ZonedTime -> a - readRFC3339 :: a -> Maybe ZonedTime - formatRFC3339 :: [a] - --- | For now there is only an instance for the String data type -instance RFC3339 String where - showRFC3339 zt@(ZonedTime lt z) = - formatTime defaultTimeLocale "%FT%T" zt ++ printZone - where - timeZoneStr = timeZoneOffsetString z - printZone = if timeZoneStr == timeZoneOffsetString utc +formatTimeRFC3339 :: (TextualMonoid t) => ZonedTime -> t +formatTimeRFC3339 zt@(ZonedTime lt z) = fromString (formatTime defaultTimeLocale "%FT%T" zt) <> fromString printZone + where timeZoneStr = timeZoneOffsetString z + printZone = if timeZoneStr == timeZoneOffsetString utc then "Z" - else take 3 timeZoneStr ++ ":" ++ drop 3 timeZoneStr - formatRFC3339 = [ "%FT%TZ" - , "%FT%T%z" - , "%FT%T%Q%z" - , "%FT%T%QZ" - ] - readRFC3339 t = foldr (tryP t) Nothing $ map p formatRFC3339 - where - p :: String -> String -> Maybe ZonedTime - p f s = parseTime defaultTimeLocale f s + else take 3 timeZoneStr <> ":" <> drop 3 timeZoneStr - tryP :: String -> (String -> Maybe a) -> Maybe a -> Maybe a - tryP s f acc | isJust acc = acc - | otherwise = f s +formatsRFC3339 :: [Text] +formatsRFC3339 = [ "%FT%TZ" + , "%FT%T%z" + , "%FT%T%Q%z" + , "%FT%T%QZ" + ] -showTime :: IO String -showTime = getZonedTime >>= return . showRFC3339 +parseTimeRFC3339 :: (TextualMonoid t) => t -> Maybe ZonedTime +parseTimeRFC3339 = parseTimeUsing formatsRFC3339 diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs new file mode 100644 --- /dev/null +++ b/Data/Time/RFC822.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} +-- | Support for reading and displaying time in the format specified by +-- the RFC822 section 5. +-- +-- Example of usage: +-- +-- > import Data.Time.LocalTime +-- > +-- > showTime :: IO Text +-- > showTime = formatTimeRFC822 <$> getZonedTime +-- > +-- > example1 = "Wed, 02 Oct 2002 13:00:00 GMT" +-- > example2 = "Wed, 02 Oct 2002 13:00:00 +0100" +-- > example3 = "Wed, 02 Oct 2002 13:00 +0100" +-- > example4 = "02 Oct 2002 13:00 +0100" +-- > example5 = "02 Oct 02 13:00 +0100" +-- > examples = [example1, example2, example3, example4, example5] +-- > +-- > readAll = map parseTimeRFC822 examples + +module Data.Time.RFC822 ( + -- * Basic type class + -- $basic + formatTimeRFC822, parseTimeRFC822 +) where + +import Control.Applicative + +import Data.Maybe +import Data.Monoid.Textual hiding (foldr, map) +import Data.String (fromString) +import Data.Text (Text) +import Data.Time.Calendar +import Data.Time.Format +import Data.Time.Locale.Compat +import Data.Time.LocalTime +import Data.Time.Util + + +test1 = "Wed, 02 Oct 2002 13:00:00 GMT" +test2 = "Wed, 02 Oct 2002 13:00:00 +0100" +test3 = "Wed, 02 Oct 2002 13:00 +0100" +test4 = "02 Oct 2002 13:00 +0100" +test5 = "02 Oct 02 13:00 +0100" +tests :: [Text] +tests = [test1, test2, test3, test4, test5] +testParse = length (catMaybes (map parseTimeRFC822 tests)) == length tests + + +formatTimeRFC822 :: (TextualMonoid t) => ZonedTime -> t +formatTimeRFC822 zonedTime = fromString $ formatTime defaultTimeLocale "%a, %d %b %Y %X %z" zonedTime + +formatsRFC822 :: [Text] +formatsRFC822 = [ "%a, %d %b %y %X %z" + , "%a, %d %b %y %X %Z" + , "%a, %d %b %y %H:%M %z" + , "%a, %d %b %y %H:%M %Z" + , "%a, %d %b %Y %X %z" + , "%a, %d %b %Y %X %Z" + , "%a, %d %b %Y %H:%M %z" + , "%a, %d %b %Y %H:%M %Z" + , "%d %b %y %X %z" + , "%d %b %y %X %Z" + , "%d %b %y %H:%M %z" + , "%d %b %y %H:%M %Z" + , "%d %b %Y %X %z" + , "%d %b %Y %X %Z" + , "%d %b %Y %H:%M %z" + , "%d %b %Y %H:%M %Z" + ] + +parseTimeRFC822 :: (TextualMonoid t) => t -> Maybe ZonedTime +parseTimeRFC822 = parseTimeUsing formatsRFC822 diff --git a/Data/Time/Util.hs b/Data/Time/Util.hs new file mode 100644 --- /dev/null +++ b/Data/Time/Util.hs @@ -0,0 +1,20 @@ +module Data.Time.Util where + +import Control.Applicative + +import Data.Function +import Data.Monoid (mempty) +import Data.Monoid.Textual hiding (foldr, map) +import Data.Time.Format (defaultTimeLocale) +import Data.Time + + +toString :: (TextualMonoid t) => t -> String +toString = flip fix mempty $ \recurse output input -> case splitCharacterPrefix input of + Just (char, suffix) -> recurse (output ++ [char]) suffix + _ -> output + +parseTimeUsing :: (TextualMonoid t, TextualMonoid t') => [t] -> t' -> Maybe ZonedTime +parseTimeUsing formats t = foldr (<|>) Nothing $ map parse formats + where parse :: (TextualMonoid t) => t -> Maybe ZonedTime + parse format = parseTime defaultTimeLocale (toString format) (toString t) diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,80 @@ +module Test where + +import Data.Fixed (E12, Fixed (..)) +import Data.Text +import Data.Time.Calendar +import Data.Time.LocalTime +import Data.Time.RFC2822 +import Data.Time.RFC3339 +import Data.Time.RFC822 + +import Distribution.TestSuite.QuickCheck +import Test.QuickCheck hiding (Fixed) + + +instance Arbitrary TimeOfDay where + arbitrary = TimeOfDay <$> choose (0, 23) <*> choose (0, 59) <*> pure 0 + +instance Arbitrary Day where + arbitrary = ModifiedJulianDay <$> arbitrary + +instance Arbitrary LocalTime where + arbitrary = LocalTime <$> arbitrary <*> arbitrary + +instance Arbitrary TimeZone where + arbitrary = TimeZone <$> arbitrary <*> arbitrary <*> elements timeZones + where timeZones = [ "ACDT", "ACST", "ACT", "ACT", "ADT", "AEDT" + , "AEST", "AFT", "AKDT", "AKST", "AMST", "AMST" + , "AMT", "AMT", "ART", "AST", "AST", "AWDT", "AWST" + , "AZOST", "AZT", "BDT", "BIOT", "BIT", "BOT" + , "BRST", "BRT", "BST", "BST", "BTT", "CAT", "CCT" + , "CDT", "CDT", "CEDT", "CEST", "CET", "CHADT" + , "CHAST", "CHOT", "ChST", "CHUT", "CIST", "CIT" + , "CKT", "CLST", "CLT", "COST", "COT", "CST", "CST" + , "CST", "CST", "CST", "CT", "CVT", "CWST", "CXT" + , "DAVT", "DDUT", "DFT", "EASST", "EAST", "EAT" + , "ECT", "ECT", "EDT", "EEDT", "EEST", "EET" + , "EGST", "EGT", "EIT", "EST", "EST", "FET", "FJT" + , "FKST", "FKST", "FKT", "FNT", "GALT", "GAMT" + , "GET", "GFT", "GILT", "GIT", "GMT", "GST", "GST" + , "GYT", "HADT", "HAEC", "HAST", "HKT", "HMT" + , "HOVT", "HST", "ICT", "IDT", "IOT", "IRDT" + , "IRKT", "IRST", "IST", "IST", "IST", "JST", "KGT" + , "KOST", "KRAT", "KST", "LHST", "LHST", "LINT" + , "MAGT", "MART", "MAWT", "MDT", "MET", "MEST" + , "MHT", "MIST", "MIT", "MMT", "MSK", "MST", "MST" + , "MST", "MUT", "MVT", "MYT", "NCT", "NDT", "NFT" + , "NPT", "NST", "NT", "NUT", "NZDT", "NZST", "OMST" + , "ORAT", "PDT", "PET", "PETT", "PGT", "PHOT" + , "PKT", "PMDT", "PMST", "PONT", "PST", "PST" + , "PYST", "PYT", "RET", "ROTT", "SAKT", "SAMT" + , "SAST", "SBT", "SCT", "SGT", "SLST", "SRET" + , "SRT", "SST", "SST", "SYOT", "TAHT", "THA", "TFT" + , "TJT", "TKT", "TLT", "TMT", "TOT", "TVT", "UCT" + , "ULAT", "USZ1", "UTC", "UYST", "UYT", "UZT" + , "VET", "VLAT", "VOLT", "VOST", "VUT", "WAKT" + , "WAST", "WAT", "WEDT", "WEST", "WET", "WIT" + , "WST", "YAKT", "YEKT", "Z" ] + +instance Arbitrary ZonedTime where + arbitrary = ZonedTime <$> arbitrary <*> arbitrary + + +tests :: IO [Test] +tests = return + [ testProperty "Inverse RFC 3339." prop_inverseRFC3339 + , testProperty "Inverse RFC 2822." prop_inverseRFC2822 + , testProperty "Inverse RFC 822." prop_inverseRFC822 + ] + +prop_inverseRFC3339 :: ZonedTime -> Bool +prop_inverseRFC3339 zonedTime = (fmap zonedTimeToUTC . parseTimeRFC3339 . asText . formatTimeRFC3339) zonedTime == Just (zonedTimeToUTC zonedTime) + +prop_inverseRFC2822 :: ZonedTime -> Bool +prop_inverseRFC2822 zonedTime = (fmap zonedTimeToUTC . parseTimeRFC2822 . asText . formatTimeRFC2822) zonedTime == Just (zonedTimeToUTC zonedTime) + +prop_inverseRFC822 :: ZonedTime -> Bool +prop_inverseRFC822 zonedTime = (fmap zonedTimeToUTC . parseTimeRFC822 . asText . formatTimeRFC822) zonedTime == Just (zonedTimeToUTC zonedTime) + +asText :: Text -> Text +asText = id diff --git a/timerep.cabal b/timerep.cabal --- a/timerep.cabal +++ b/timerep.cabal @@ -1,41 +1,59 @@ -Name: timerep -Version: 1.0.4 -Category: Web, Time -Synopsis: Parse and display time according to some RFCs (RFC3339, RFC2822) -Description: +name: timerep +version: 2.0.0 +category: Web, Time +synopsis: Parse and display time according to some RFCs (RFC3339, RFC2822, RFC822) +description: . Parse and display time according to some RFC's. - Supported: - RFC3339 - RFC2822 . - This package defines a type class to parse and read time representations - specified in some RFC's. - Right now there is only support for reading and showing String + Supported: . + * RFC822 + * RFC2822 + * RFC3339 + . Special thanks to Koral for all the suggestions and help in solving some bugs . -Build-type: Simple -Maintainer: Hugo Daniel Gomes -Author: Hugo Daniel Gomes -Copyright: Hugo Daniel Gomes -Cabal-version: >= 1.6 -License: BSD3 -License-file: LICENSE -source-repository head - type: git +build-type: Simple +maintainer: Hugo Daniel Gomes +author: Hugo Daniel Gomes +copyright: Hugo Daniel Gomes +cabal-version: >= 1.8 +license: BSD3 +license-file: LICENSE +source-repository head + type: git location: git://github.com/HugoDaniel/RFC3339.git library build-depends: - base < 5, - time >= 1.2, - attoparsec, - old-locale + base < 5, + monoid-subclasses, + text, + time >= 1.5, + time-locale-compat, + attoparsec exposed-modules: Data.Time.RFC3339 Data.Time.RFC2822 + Data.Time.RFC822 + other-modules: + Data.Time.Util + extensions: TypeSynonymInstances FlexibleInstances +test-suite Tests + type: detailed-0.9 + hs-source-dirs: test + test-module: Test + build-depends: + base < 5, + Cabal >= 1.20.0, + cabal-test-quickcheck, + QuickCheck, + text, + time >= 1.2, + time-locale-compat, + timerep >= 1.0