Merge branch 'convertible'

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

diff --git a/Data/Time/Format/C.hs b/Data/Time/Format/C.hs
new file mode 100644 (file)
index 0000000..0c204d5
--- /dev/null
+++ b/Data/Time/Format/C.hs
@@ -0,0 +1,114 @@
+{-# LANGUAGE
+    FlexibleInstances
+  , MultiParamTypeClasses
+  , OverloadedStrings
+  , TemplateHaskell
+  , UnicodeSyntax
+  #-}
+-- |This module provides functions for ANSI C's date and time strings.
+--
+-- ANSI C's @ctime(3)@/@asctime(3)@ format looks like:
+--
+-- @Wdy Mon [D]D HH:MM:SS YYYY@
+--
+-- The exact syntax is as follows:
+--
+-- > date-time ::= wday SP month SP day SP time SP year
+-- > wday      ::= "Mon" | "Tue" | "Wed" | "Thu"
+-- >             | "Fri" | "Sat" | "Sun"
+-- > month     ::= "Jan" | "Feb" | "Mar" | "Apr"
+-- >             | "May" | "Jun" | "Jul" | "Aug"
+-- >             | "Sep" | "Oct" | "Nov" | "Dec"
+-- > day       ::= 2DIGIT | SP 1DIGIT
+-- > time      ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]
+-- > year      ::= 4DIGIT
+module Data.Time.Format.C
+    ( C
+    , c
+    , cDateAndTime
+    )
+    where
+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.Format.HTTP.Common
+import Prelude.Unicode
+
+-- |The phantom type for conversions between ANSI C's date and time
+-- strings and 'LocalTime'.
+--
+-- >>> convertSuccess (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))
+-- Tagged "Sun Nov  6 08:49:37 1994"
+data C
+
+-- |The proxy for conversions between ANSI C's date and time strings
+-- and 'LocalTime'.
+c ∷ Proxy C
+{-# INLINE CONLIKE c #-}
+c = Proxy
+
+instance ConvertSuccess LocalTime (Tagged C Ascii) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
+
+instance ConvertSuccess LocalTime (Tagged C AsciiBuilder) where
+    {-# INLINE convertSuccess #-}
+    convertSuccess = Tagged ∘ toAsciiBuilder
+
+instance ConvertAttempt (Tagged C Ascii) LocalTime where
+    {-# INLINE convertAttempt #-}
+    convertAttempt = parseAttempt' cDateAndTime ∘ untag
+
+-- |Parse an ANSI C's date and time string.
+cDateAndTime ∷ Parser LocalTime
+cDateAndTime
+    = 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 C Ascii        |])
+               , ([t| LocalTime |], [t| Tagged C AsciiBuilder |])
+               ]