Rewrote RFC733

[time-http.git] / Data / Time / Asctime.hs

diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs
index 0814e451f9f0f82e37f849da656740adb0e09103..f8d28ccd80091fb0424c779245aaa6627d50068a 100644 (file)
--- a/Data/Time/Asctime.hs
+++ b/Data/Time/Asctime.hs
@@ -1,5 +1,9 @@
 {-# LANGUAGE
-    UnicodeSyntax
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TemplateHaskell
+  , UnicodeSyntax
   #-}
 -- |This module provides functions for ANSI C's asctime() format.
 --
@@ -22,31 +26,83 @@
 -- As you can see, it has no time zone info. "Data.Time.HTTP" will
 -- treat it as UTC.
 module Data.Time.Asctime
-    ( -- * Formatting
-      toAscii
-    , toAsciiBuilder
-
-      -- * Parsing
-    , fromAscii
+    ( Asctime
     , asctime
     )
     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.Asctime.Internal
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
 import Prelude.Unicode
 
--- |Convert a 'LocalTime' to ANSI C's @asctime()@ string.
-toAscii ∷ LocalTime → Ascii
-toAscii = A.fromAsciiBuilder ∘ toAsciiBuilder
+-- |The phantom type for conversion between ANSI C's @asctime()@
+-- string and 'LocalTime'.
+--
+-- >>> convertSuccess (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))
+-- Tagged "Sun Nov  6 08:49:37 1994"
+data Asctime
 
--- |Parse an ANSI C's @asctime()@ string. When the string can't be
--- parsed, it returns @'Left' err@.
-fromAscii ∷ Ascii → Either String LocalTime
-fromAscii = P.parseOnly p ∘ A.toByteString
-    where
-      p = do zt ← asctime
-             P.endOfInput
-             return zt
+instance ConvertSuccess LocalTime (Tagged Asctime Ascii) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess LocalTime (Tagged Asctime AsciiBuilder) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged Asctime Ascii) LocalTime where
+    {-# INLINE convertAttempt #-}
+    convertAttempt = parseAttempt' asctime ∘ untag
+
+-- |Parse an ANSI C's @asctime()@ string.
+asctime ∷ Parser LocalTime
+asctime = do weekDay ← shortWeekDayNameP
+             _       ← char ' '
+             month   ← shortMonthNameP
+             _       ← char ' '
+             day     ← read2'
+             _       ← char ' '
+             hour    ← read2
+             _       ← char ':'
+             minute  ← read2
+             _       ← char ':'
+             second  ← read2
+             _       ← char ' '
+             year    ← read4
+
+             gregDay ← assertGregorianDateIsGood year month day
+             _       ← assertWeekDayIsGood weekDay gregDay
+             tod     ← assertTimeOfDayIsGood hour minute second
+
+             return (LocalTime gregDay tod)
+
+toAsciiBuilder ∷ LocalTime → AsciiBuilder
+toAsciiBuilder localTime
+    = let (year, month, day) = toGregorian (localDay localTime)
+          (_, _, week)       = toWeekDate  (localDay localTime)
+          timeOfDay          = localTimeOfDay localTime
+      in
+        shortWeekDayName week
+        ⊕ A.toAsciiBuilder " "
+        ⊕ shortMonthName month
+        ⊕ A.toAsciiBuilder " "
+        ⊕ show2' day
+        ⊕ A.toAsciiBuilder " "
+        ⊕ show2 (todHour timeOfDay)
+        ⊕ A.toAsciiBuilder ":"
+        ⊕ show2 (todMin timeOfDay)
+        ⊕ A.toAsciiBuilder ":"
+        ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
+        ⊕ A.toAsciiBuilder " "
+        ⊕ show4 year
+
+deriveAttempts [ ([t| LocalTime |], [t| Tagged Asctime Ascii        |])
+               , ([t| LocalTime |], [t| Tagged Asctime AsciiBuilder |])
+               ]