diff --git a/CHANGES.md b/CHANGES.md new file mode 100644 --- /dev/null +++ b/CHANGES.md @@ -0,0 +1,9 @@ +Change log +========== + +#### 2.0.0.1 +- Compatibility with monoid-subclasses >= 0.4.1 +- Renamed github repository to match package name + +#### 2.0.0 +- Added initial support for RFC822 diff --git a/Data/Time/RFC2822.hs b/Data/Time/RFC2822.hs --- a/Data/Time/RFC2822.hs +++ b/Data/Time/RFC2822.hs @@ -50,28 +50,10 @@ 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" -test3 = "Tue, 1 Jul 2003 10:52:37 +0200" -test4 = "Thu, 13 Feb 1969 23:32:54 -0330" -test5 = "Mon, 24 Nov 1997 14:22:01 -0800" -test6 = "Thu, 13\n Feb\n 1969\n 23:32\n -0330" -test7 = "Thu, 13\n Feb\n 1969\n 23:32\n -0330 (Newfoundland Time)" -- Fails -test8 = "24 Nov 1997 14:22:01 -0800" -test9 = "15 Nov 1994 12:45:26 GMT" -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 :: [Text] -tests = [test1, test2, test3, test4, test5, test6, test7, test8, test9, test10 - , test11, test12] -testParse = length (catMaybes (map parseTimeRFC2822 tests)) == length tests - 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 @@ -94,9 +76,9 @@ 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' + parse format = parseTime defaultTimeLocale (toString' format) t' -- t' is a trimmed t (currently only \n is trimmed) -- TODO: trim other white space characters t' :: String - t' = lines (toString t) >>= ("" ++) + 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 @@ -38,25 +38,14 @@ import Control.Applicative import Data.Maybe -import Data.Monoid ((<>)) -import Data.Monoid.Textual hiding (foldr, map) -import Data.String (fromString) -import Data.Text (Text) +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 :: [Text] -tests = [test1, test2, test3, test4, test5] -testParse = length (catMaybes (map parseTimeRFC3339 tests)) == length tests formatTimeRFC3339 :: (TextualMonoid t) => ZonedTime -> t diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs --- a/Data/Time/RFC822.hs +++ b/Data/Time/RFC822.hs @@ -29,24 +29,13 @@ import Control.Applicative import Data.Maybe -import Data.Monoid.Textual hiding (foldr, map) -import Data.String (fromString) -import Data.Text (Text) +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 diff --git a/Data/Time/Util.hs b/Data/Time/Util.hs --- a/Data/Time/Util.hs +++ b/Data/Time/Util.hs @@ -3,18 +3,16 @@ import Control.Applicative import Data.Function -import Data.Monoid (mempty) +import Data.Monoid (mempty) import Data.Monoid.Textual hiding (foldr, map) -import Data.Time.Format (defaultTimeLocale) import Data.Time +import Data.Time.Format (defaultTimeLocale) -toString :: (TextualMonoid t) => t -> String -toString = flip fix mempty $ \recurse output input -> case splitCharacterPrefix input of - Just (char, suffix) -> recurse (output ++ [char]) suffix - _ -> output +toString' :: (TextualMonoid t) => t -> String +toString' = toString (maybe "?" (:[]) . characterPrefix) 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) + parse format = parseTime defaultTimeLocale (toString' format) (toString' t) diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,22 @@ +timerep +======= + +This started out as a simple project to parse and display time according to +[RFC 3339](http://tools.ietf.org/html/rfc3339), but with time gained ability +to convert to and from other RFCs as well. + +You will find a change log in `CHANGES.md`. + + +### Todos + +- Get rid of the `formatTime` function, and use a more decent pretty + printing lib. +- Do some proper parsing (it parses nicely, but this was just a quick hack + that my mind produced while being stressed to finish this). + + +### License + +This project is licensed under a 3-clause BSD license as specified in the +`LICENSE` file. diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,115 @@ +import Data.Fixed (E12, Fixed (..)) +import Data.Maybe +import Data.Text +import Data.Time.Calendar +import Data.Time.LocalTime +import Data.Time.RFC2822 +import Data.Time.RFC3339 +import Data.Time.RFC822 + +import Test.QuickCheck hiding (Fixed) +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + + +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 + + +main :: IO () +main = defaultMain $ testGroup "Tests" [unitTests, properties] + + +unitTests :: TestTree +unitTests = testGroup "Unit tests" [casesRFC3339 , casesRFC2822, casesRFC822] + +casesRFC3339, casesRFC2822 :: TestTree +casesRFC3339 = testCase "RFC 3339 cases" $ do + isJust (parseTimeRFC3339 "1985-04-12T23:20:50.52Z") @?= True + isJust (parseTimeRFC3339 "1996-12-19T16:39:57-08:00") @?= True + isJust (parseTimeRFC3339 "1990-12-31T23:59:60Z") @?= True + isJust (parseTimeRFC3339 "1990-12-31T15:59:60-08:00") @?= True + isJust (parseTimeRFC3339 "1937-01-01T12:00:27.87+00:20") @?= True +casesRFC2822 = testCase "RFC 2822 cases" $ do + isJust (parseTimeRFC2822 "Fri, 21 Nov 1997 09:55:06 -0600") @?= True + isJust (parseTimeRFC2822 "Tue, 15 Nov 1994 12:45:26 GMT") @?= True + isJust (parseTimeRFC2822 "Tue, 1 Jul 2003 10:52:37 +0200") @?= True + isJust (parseTimeRFC2822 "Thu, 13 Feb 1969 23:32:54 -0330") @?= True + isJust (parseTimeRFC2822 "Mon, 24 Nov 1997 14:22:01 -0800") @?= True + isJust (parseTimeRFC2822 "Thu, 13\n Feb\n 1969\n 23:32\n -0330") @?= True + isJust (parseTimeRFC2822 "Thu, 13\n Feb\n 1969\n 23:32\n -0330 (Newfoundland Time)") @?= False + isJust (parseTimeRFC2822 "24 Nov 1997 14:22:01 -0800") @?= True + isJust (parseTimeRFC2822 "15 Nov 1994 12:45:26 GMT") @?= True + isJust (parseTimeRFC2822 "Mon,24 Nov 1997 14:22:01 -0800") @?= False + isJust (parseTimeRFC2822 "Thu,\t13\n Feb\n 1969\n 23:32\n -0330 (Newfoundland Time)") @?= False + isJust (parseTimeRFC2822 "Thu, 13 Feb 1969 23:32 -0330 (Newfoundland Time)") @?= False +casesRFC822 = testCase "RFC 822 cases" $ do + isJust (parseTimeRFC822 "Wed, 02 Oct 2002 13:00:00 GMT") @?= True + isJust (parseTimeRFC822 "Wed, 02 Oct 2002 13:00:00 +0100") @?= True + isJust (parseTimeRFC822 "Wed, 02 Oct 2002 13:00 +0100") @?= True + isJust (parseTimeRFC822 "02 Oct 2002 13:00 +0100") @?= True + isJust (parseTimeRFC822 "02 Oct 02 13:00 +0100") @?= True + + +properties :: TestTree +properties = testGroup "Properties" + [ inverseRFC3339Property + , inverseRFC2822Property + , inverseRFC822Property + ] + +inverseRFC3339Property, inverseRFC2822Property, inverseRFC822Property :: TestTree +inverseRFC3339Property = testProperty "parse . format = id (RFC3339)" $ \zonedTime -> + (fmap zonedTimeToUTC . parseTimeRFC3339 . asText . formatTimeRFC3339) zonedTime == Just (zonedTimeToUTC zonedTime) +inverseRFC2822Property = testProperty "parse . format = id (RFC2822)" $ \zonedTime -> + (fmap zonedTimeToUTC . parseTimeRFC2822 . asText . formatTimeRFC2822) zonedTime == Just (zonedTimeToUTC zonedTime) +inverseRFC822Property = testProperty "parse . format = id (RFC822)" $ \zonedTime -> + (fmap zonedTimeToUTC . parseTimeRFC822 . asText . formatTimeRFC822) zonedTime == Just (zonedTimeToUTC zonedTime) + +asText :: Text -> Text +asText = id diff --git a/test/Test.hs b/test/Test.hs deleted file mode 100644 --- a/test/Test.hs +++ /dev/null @@ -1,80 +0,0 @@ -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,37 +1,42 @@ name: timerep -version: 2.0.0 -category: Web, Time +version: 2.0.0.1 +category: Web, Time, Parser, Text synopsis: Parse and display time according to some RFCs (RFC3339, RFC2822, RFC822) description: - . Parse and display time according to some RFC's. . Supported: . * RFC822 + . * RFC2822 - * RFC3339 . - Special thanks to Koral for all the suggestions and help in solving some bugs + * 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 +copyright: (c) 2010-2015 Hugo Daniel Gomes cabal-version: >= 1.8 +homepage: https://github.com/HugoDaniel/timerep +bug-reports: https://github.com/HugoDaniel/timerep/issues license: BSD3 license-file: LICENSE +extra-source-files: + README.md, + CHANGES.md + source-repository head type: git - location: git://github.com/HugoDaniel/RFC3339.git + location: git://github.com/HugoDaniel/timerep.git library build-depends: base < 5, - monoid-subclasses, + monoid-subclasses >= 0.4.1, text, time >= 1.5, - time-locale-compat, attoparsec exposed-modules: @@ -42,18 +47,18 @@ other-modules: Data.Time.Util - extensions: TypeSynonymInstances FlexibleInstances + ghc-options: -Wall test-suite Tests - type: detailed-0.9 + type: exitcode-stdio-1.0 hs-source-dirs: test - test-module: Test + main-is: Main.hs build-depends: base < 5, - Cabal >= 1.20.0, - cabal-test-quickcheck, QuickCheck, + tasty, + tasty-hunit, + tasty-quickcheck, text, - time >= 1.2, - time-locale-compat, - timerep >= 1.0 + time >= 1.5, + timerep >= 2