Merge branch 'convertible'

[time-http.git] / Data / Time / Format / RFC1123.hs

diff --git a/Data/Time/RFC1123/Internal.hs b/Data/Time/Format/RFC1123.hs
similarity index 51%
rename from Data/Time/RFC1123/Internal.hs
rename to Data/Time/Format/RFC1123.hs
index 4ae25b76b7c48d452c70367682da65112ee5ac27..1d4f28eb99c5d328d8d8dc5357d0d8a43ba19231 100644 (file)
--- a/Data/Time/RFC1123/Internal.hs
+++ b/Data/Time/Format/RFC1123.hs
@@ -1,21 +1,65 @@
 {-# LANGUAGE
-    OverloadedStrings
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TemplateHaskell
   , UnicodeSyntax
   #-}
--- |Internal functions for "Data.Time.RFC1123".
-module Data.Time.RFC1123.Internal
-    ( rfc1123DateAndTime
-    , toAsciiBuilder
+-- |This module provides functions to parse and format RFC 1123 date
+-- and time strings (<http://tools.ietf.org/html/rfc1123#page-55>).
+--
+-- The format is basically the same as RFC 822, but the syntax for
+-- @date@ is changed from:
+--
+-- > year ::= 2DIGIT
+--
+-- to:
+--
+-- > year ::= 4DIGIT
+module Data.Time.Format.RFC1123
+    ( RFC1123
+    , rfc1123
+    , rfc1123DateAndTime
     )
     where
-import Data.Ascii (AsciiBuilder)
+import Control.Applicative
+import Data.Ascii (Ascii, AsciiBuilder)
 import qualified Data.Ascii as A
 import Data.Attoparsec.Char8
+import Data.Convertible.Base
 import Data.Monoid.Unicode
+import Data.Proxy
+import Data.Tagged
 import Data.Time
 import Data.Time.Calendar.WeekDate
-import Data.Time.HTTP.Common
-import Data.Time.RFC822.Internal hiding (toAsciiBuilder)
+import Data.Time.Format.HTTP.Common
+import Data.Time.Format.RFC822.Internal
+import Prelude.Unicode
+
+-- |The phantom type for conversions between RFC 1123 date and time
+-- strings and 'ZonedTime'.
+--
+-- >>> convertSuccess (ZonedTime (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37)) utc)
+-- Tagged "Sun, 06 Nov 1994 08:49:37 GMT"
+data RFC1123
+
+-- |The proxy for conversions between RFC 1123 date and time strings
+-- and 'ZonedTime'.
+rfc1123 ∷ Proxy RFC1123
+{-# INLINE CONLIKE rfc1123 #-}
+rfc1123 = Proxy
+
+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
@@ -32,7 +76,7 @@ dateTime = do weekDay ← optionMaybe $
                     → return ()
                 Just givenWD
                     → assertWeekDayIsGood givenWD gregDay
-              (tod, timeZone) ← rfc822time
+              (tod, timeZone) ← rfc822Time
               let lt = LocalTime gregDay tod
                   zt = ZonedTime lt timeZone
               return zt
@@ -46,7 +90,6 @@ date = do day   ← read2
           _     ← char ' '
           assertGregorianDateIsGood year month day
 
--- |Convert a 'ZonedTime' to RFC 1123 date and time string.
 toAsciiBuilder ∷ ZonedTime → AsciiBuilder
 toAsciiBuilder zonedTime
     = let localTime          = zonedTimeToLocalTime zonedTime
@@ -69,4 +112,8 @@ toAsciiBuilder zonedTime
         ⊕ A.toAsciiBuilder ":"
         ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
         ⊕ A.toAsciiBuilder " "
-        ⊕ showRFC822TimeZone timeZone
+        ⊕ untag (cs timeZone ∷ Tagged RFC822 AsciiBuilder)
+
+deriveAttempts [ ([t| ZonedTime |], [t| Tagged RFC1123 Ascii        |])
+               , ([t| ZonedTime |], [t| Tagged RFC1123 AsciiBuilder |])
+               ]