RFC1123

Ditz-issue: 0a3272772c73cf31486eb2b6691fa38232d3c4c5

diff --git a/Data/Time/HTTP/Internal.hs b/Data/Time/HTTP/Internal.hs
index 6e0753dc1580bb49ed0890022988a3d98d25905b..b008d9da6911d530050ae3d91a32efbf94afcd75 100644 (file)
--- a/Data/Time/HTTP/Internal.hs
+++ b/Data/Time/HTTP/Internal.hs
@@ -10,8 +10,10 @@ module Data.Time.HTTP.Internal
 import Control.Applicative
 import Data.Ascii (AsciiBuilder)
 import Data.Attoparsec.Char8
+import Data.Convertible.Base
+import Data.Tagged
 import Data.Time
-import qualified Data.Time.RFC1123.Internal as RFC1123
+import Data.Time.RFC1123
 import Data.Time.RFC733
 import Data.Time.Asctime
 import Prelude.Unicode
@@ -20,17 +22,23 @@ import Prelude.Unicode
 -- (RFC 2616).
 httpDateAndTime ∷ Parser UTCTime
 httpDateAndTime
-    = choice [ zonedTimeToUTC     <$> try RFC1123.rfc1123DateAndTime
+    = choice [ zonedTimeToUTC     <$> try rfc1123DateAndTime
              , zonedTimeToUTC     <$> try rfc733DateAndTime
              , localTimeToUTC utc <$> asctime
              ]
 
 -- |Convert a 'UTCTime' to RFC 1123 date and time string.
 toAsciiBuilder ∷ UTCTime → AsciiBuilder
-toAsciiBuilder = RFC1123.toAsciiBuilder ∘ ut2zt
+toAsciiBuilder = untag' ∘ cs ∘ ut2zt
     where
+      untag' ∷ Tagged RFC1123 AsciiBuilder → AsciiBuilder
+      {-# INLINE CONLIKE untag' #-}
+      untag' = untag
+
       ut2zt ∷ UTCTime → ZonedTime
+      {-# INLINE ut2zt #-}
       ut2zt = utcToZonedTime gmt
 
       gmt ∷ TimeZone
+      {-# INLINE CONLIKE gmt #-}
       gmt = TimeZone 0 False "GMT"

diff --git a/Data/Time/RFC1123.hs b/Data/Time/RFC1123.hs
index fb7839d034bbc9dc7aaae2369170f00e59a568f8..c00bf732b64e59e2a88e7e387e9fec39833ff491 100644 (file)
--- a/Data/Time/RFC1123.hs
+++ b/Data/Time/RFC1123.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE
-    UnicodeSyntax
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TemplateHaskell
+  , UnicodeSyntax
   #-}
 -- |This module provides functions to parse and format RFC 1123 date
 -- and time formats.
@@ -13,31 +17,91 @@
 --
 -- > year ::= 4DIGIT
 module Data.Time.RFC1123
-    ( -- * Formatting
-      toAscii
-    , toAsciiBuilder
-
-      -- * Parsing
-    , fromAscii
+    ( RFC1123
     , rfc1123DateAndTime
     )
     where
-import Data.Ascii (Ascii)
+import Control.Applicative
+import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
-import qualified Data.Attoparsec.Char8 as P
+import Data.Attoparsec.Char8
+import Data.Convertible.Base
+import Data.Monoid.Unicode
+import Data.Tagged
 import Data.Time
-import Data.Time.RFC1123.Internal
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Data.Time.RFC822
 import Prelude.Unicode
 
--- |Convert a 'ZonedTime' to RFC 1123 date and time string.
-toAscii ∷ ZonedTime → Ascii
-toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder
+-- FIXME: doc
+data RFC1123
 
--- |Parse an RFC 1123 date and time string. When the string can't be
--- parsed, it returns @'Left' err@.
-fromAscii ∷ Ascii → Either String ZonedTime
-fromAscii = P.parseOnly p ∘ A.toByteString
-    where
-      p = do zt ← rfc1123DateAndTime
-             P.endOfInput
-             return zt
+instance ConvertSuccess ZonedTime (Tagged RFC1123 Ascii) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess ZonedTime (Tagged RFC1123 AsciiBuilder) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged RFC1123 Ascii) ZonedTime where
+    {-# INLINE convertAttempt #-}
+    convertAttempt = parseAttempt' rfc1123DateAndTime ∘ untag
+
+-- |Parse an RFC 1123 date and time string.
+rfc1123DateAndTime ∷ Parser ZonedTime
+rfc1123DateAndTime = dateTime
+
+dateTime ∷ Parser ZonedTime
+dateTime = do weekDay ← optionMaybe $
+                         do w ← shortWeekDayNameP
+                            _ ← string ", "
+                            return w
+              gregDay ← date
+              case weekDay of
+                Nothing
+                    → return ()
+                Just givenWD
+                    → assertWeekDayIsGood givenWD gregDay
+              (tod, timeZone) ← rfc822Time
+              let lt = LocalTime gregDay tod
+                  zt = ZonedTime lt timeZone
+              return zt
+
+date ∷ Parser Day
+date = do day   ← read2
+          _     ← char ' '
+          month ← shortMonthNameP
+          _     ← char ' '
+          year  ← read4
+          _     ← char ' '
+          assertGregorianDateIsGood year month day
+
+toAsciiBuilder ∷ ZonedTime → AsciiBuilder
+toAsciiBuilder zonedTime
+    = let localTime          = zonedTimeToLocalTime zonedTime
+          timeZone           = zonedTimeZone zonedTime
+          (year, month, day) = toGregorian (localDay localTime)
+          (_, _, week)       = toWeekDate  (localDay localTime)
+          timeOfDay          = localTimeOfDay localTime
+      in
+        shortWeekDayName week
+        ⊕ A.toAsciiBuilder ", "
+        ⊕ show2 day
+        ⊕ A.toAsciiBuilder " "
+        ⊕ shortMonthName month
+        ⊕ A.toAsciiBuilder " "
+        ⊕ show4 year
+        ⊕ A.toAsciiBuilder " "
+        ⊕ show2 (todHour timeOfDay)
+        ⊕ A.toAsciiBuilder ":"
+        ⊕ show2 (todMin timeOfDay)
+        ⊕ A.toAsciiBuilder ":"
+        ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
+        ⊕ A.toAsciiBuilder " "
+        ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
+
+deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC1123 Ascii        |])
+               , ([t| ZonedTime |], [t| Tagged RFC1123 AsciiBuilder |])
+               ]

diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/RFC1123/Internal.hs
deleted file mode 100644 (file)
index 9fd1e83..0000000
--- a/Data/Time/RFC1123/Internal.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-{-# LANGUAGE
-    OverloadedStrings
-  , UnicodeSyntax
-  #-}
--- |Internal functions for "Data.Time.RFC1123".
-module Data.Time.RFC1123.Internal
-    ( rfc1123DateAndTime
-    , toAsciiBuilder
-    )
-    where
-import Data.Ascii (AsciiBuilder)
-import qualified Data.Ascii as A
-import Data.Attoparsec.Char8
-import Data.Convertible.Base
-import Data.Monoid.Unicode
-import Data.Tagged
-import Data.Time
-import Data.Time.Calendar.WeekDate
-import Data.Time.HTTP.Common
-import Data.Time.RFC822
-
--- |Parse an RFC 1123 date and time string.
-rfc1123DateAndTime ∷ Parser ZonedTime
-rfc1123DateAndTime = dateTime
-
-dateTime ∷ Parser ZonedTime
-dateTime = do weekDay ← optionMaybe $
-                         do w ← shortWeekDayNameP
-                            _ ← string ", "
-                            return w
-              gregDay ← date
-              case weekDay of
-                Nothing
-                    → return ()
-                Just givenWD
-                    → assertWeekDayIsGood givenWD gregDay
-              (tod, timeZone) ← rfc822Time
-              let lt = LocalTime gregDay tod
-                  zt = ZonedTime lt timeZone
-              return zt
-
-date ∷ Parser Day
-date = do day   ← read2
-          _     ← char ' '
-          month ← shortMonthNameP
-          _     ← char ' '
-          year  ← read4
-          _     ← char ' '
-          assertGregorianDateIsGood year month day
-
--- |Convert a 'ZonedTime' to RFC 1123 date and time string.
-toAsciiBuilder ∷ ZonedTime → AsciiBuilder
-toAsciiBuilder zonedTime
-    = let localTime          = zonedTimeToLocalTime zonedTime
-          timeZone           = zonedTimeZone zonedTime
-          (year, month, day) = toGregorian (localDay localTime)
-          (_, _, week)       = toWeekDate  (localDay localTime)
-          timeOfDay          = localTimeOfDay localTime
-      in
-        shortWeekDayName week
-        ⊕ A.toAsciiBuilder ", "
-        ⊕ show2 day
-        ⊕ A.toAsciiBuilder " "
-        ⊕ shortMonthName month
-        ⊕ A.toAsciiBuilder " "
-        ⊕ show4 year
-        ⊕ A.toAsciiBuilder " "
-        ⊕ show2 (todHour timeOfDay)
-        ⊕ A.toAsciiBuilder ":"
-        ⊕ show2 (todMin timeOfDay)
-        ⊕ A.toAsciiBuilder ":"
-        ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
-        ⊕ A.toAsciiBuilder " "
-        ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)

diff --git a/Data/Time/RFC822.hs b/Data/Time/RFC822.hs
index a5c1a0bd97713e68f3420756b14dea3c2d18ba89..df6527cb2372fc38ce0c20e82d506dbece32f28b 100644 (file)
--- a/Data/Time/RFC822.hs
+++ b/Data/Time/RFC822.hs
@@ -63,10 +63,12 @@ instance ConvertSuccess ZonedTime (Tagged RFC822 AsciiBuilder) where
     {-# INLINE convertSuccess #-}
     convertSuccess = Tagged ∘ toAsciiBuilder
 
+-- |FIXME: move this to RFC822.Internal
 instance ConvertSuccess TimeZone (Tagged RFC822 Ascii) where
     {-# INLINE convertSuccess #-}
     convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
 
+-- |FIXME: move this to RFC822.Internal
 instance ConvertSuccess TimeZone (Tagged RFC822 AsciiBuilder) where
     {-# INLINE convertSuccess #-}
     convertSuccess tz
@@ -106,7 +108,7 @@ date = do day   ← read2
           _     ← char ' '
           assertGregorianDateIsGood year month day
 
--- |Parse the time and time zone of an RFC 822 date and time string.
+-- |FIXME: move this to RFC822.Internal
 rfc822Time ∷ Parser (TimeOfDay, TimeZone)
 rfc822Time = do tod ← hms
                 _   ← char ' '

diff --git a/Test/Time/HTTP.hs b/Test/Time/HTTP.hs
index 7ef3210af7d0a49390bf1859613bf76be50ad443..3022d0d78c1ef3a95da6fae4d00dff11bf0ff355 100644 (file)
--- a/Test/Time/HTTP.hs
+++ b/Test/Time/HTTP.hs
@@ -13,7 +13,7 @@ import Data.Time
 import Data.Time.Asctime
 import qualified Data.Time.HTTP    as HTTP
 import Data.Time.RFC733
-import qualified Data.Time.RFC1123 as RFC1123
+import Data.Time.RFC1123
 import System.Exit
 import Prelude.Unicode
 import Test.QuickCheck
@@ -88,19 +88,22 @@ tests = [ -- Asctime
                                                         ∷ Tagged RFC733 Ascii))
 
           -- RFC1123
-        , property ( RFC1123.fromAscii "Sun, 06 Nov 1994 08:49:37 GMT"
-                     ≡ Right referenceZonedTime )
+        , property ( fromAttempt (ca (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii))
+                     ≡ Just referenceZonedTime
+                   )
 
-        , property ( "Sun, 06 Nov 1994 08:49:37 GMT"
-                     ≡ RFC1123.toAscii referenceZonedTime )
+        , property ( (Tagged "Sun, 06 Nov 1994 08:49:37 GMT" ∷ Tagged RFC1123 Ascii)
+                     ≡ cs referenceZonedTime
+                   )
 
-        , property $ \zt → Right zt ≡ RFC1123.fromAscii (RFC1123.toAscii zt)
+        , property $ \zt → Just zt ≡ fromAttempt (ca (cs (zt ∷ ZonedTime)
+                                                        ∷ Tagged RFC1123 Ascii))
 
           -- HTTP
         , property $ \ut → Right ut ≡ HTTP.fromAscii (HTTP.toAscii           ut )
         , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2lt ut) ∷ Tagged Asctime Ascii))
         , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC733  Ascii))
-        , property $ \ut → Right ut ≡ HTTP.fromAscii (RFC1123.toAscii (ut2zt ut))
+        , property $ \ut → Right ut ≡ HTTP.fromAscii (untag (cs (ut2zt ut) ∷ Tagged RFC1123 Ascii))
         ]
     where
       referenceLocalTime

diff --git a/time-http.cabal b/time-http.cabal
index 46d18ccbdb9643b6b432321363d63c64694d523a..f7668d763925fd564075043bc2fa3f300764d0e3 100644 (file)
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -35,7 +35,6 @@ Library
     Other-modules:
         Data.Time.HTTP.Common
         Data.Time.HTTP.Internal
-        Data.Time.RFC1123.Internal
 
     Build-depends:
         ascii                == 0.0.*,