From e90df736d33162bb7ade70cb6fe1372a28af62ff Mon Sep 17 00:00:00 2001
From: PHO <pho@cielonegro.org>
Date: Wed, 17 Mar 2010 17:46:59 +0900
Subject: [PATCH] Asctime

---
 Data/Time/Asctime.hs        | 46 +++++++++++++++++++++++++++++++++++++
 Data/Time/Asctime/Parsec.hs | 34 +++++++++++++++++++++++++++
 Data/Time/RFC1123/Parsec.hs |  2 +-
 Data/Time/RFC733/Parsec.hs  |  2 +-
 Data/Time/RFC822/Parsec.hs  |  2 +-
 time-http.cabal             |  2 ++
 6 files changed, 85 insertions(+), 3 deletions(-)
 create mode 100644 Data/Time/Asctime.hs
 create mode 100644 Data/Time/Asctime/Parsec.hs

diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs
new file mode 100644
index 0000000..7ebb596
--- /dev/null
+++ b/Data/Time/Asctime.hs
@@ -0,0 +1,46 @@
+module Data.Time.Asctime
+    ( format
+    , parse
+    )
+    where
+
+import qualified Text.Parsec as P
+
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Data.Time.Asctime.Parsec
+
+{-
+  Wdy Mon DD HH:MM:SS YYYY
+-}
+
+format :: LocalTime -> String
+format localTime
+    = let (year, month, day) = toGregorian (localDay localTime)
+          (_, _, week)       = toWeekDate  (localDay localTime)
+          timeOfDay          = localTimeOfDay localTime
+      in
+        concat [ shortWeekDayName week
+               , ", "
+               , shortMonthName month
+               , " "
+               , show2 day
+               , " "
+               , show2 (todHour timeOfDay)
+               , ":"
+               , show2 (todMin timeOfDay)
+               , ":"
+               , show2 (floor (todSec timeOfDay))
+               , " "
+               , show4 year
+               ]
+
+parse :: String -> Maybe LocalTime
+parse src = case P.parse p "" src of
+              Right zt -> Just zt
+              Left  _  -> Nothing
+    where
+      p = do zt <- asctime
+             _  <- P.eof
+             return zt
diff --git a/Data/Time/Asctime/Parsec.hs b/Data/Time/Asctime/Parsec.hs
new file mode 100644
index 0000000..3cff94c
--- /dev/null
+++ b/Data/Time/Asctime/Parsec.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE FlexibleContexts #-}
+module Data.Time.Asctime.Parsec
+    ( asctime
+    )
+    where
+
+import Control.Monad
+import Data.Fixed
+import Data.Time
+import Data.Time.Calendar.WeekDate
+import Data.Time.HTTP.Common
+import Text.Parsec
+
+
+asctime :: Stream s m Char => ParsecT s u m LocalTime
+asctime = do weekDay <- shortWeekDayNameP
+             _       <- string ", "
+             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)
diff --git a/Data/Time/RFC1123/Parsec.hs b/Data/Time/RFC1123/Parsec.hs
index f2176cf..ccdf0bf 100644
--- a/Data/Time/RFC1123/Parsec.hs
+++ b/Data/Time/RFC1123/Parsec.hs
@@ -39,4 +39,4 @@ date = do day   <- read2
           _     <- char ' '
           year  <- read4
           _     <- char ' '
-          assertGregorianDateIsGood (toInteger year) month day
+          assertGregorianDateIsGood year month day
diff --git a/Data/Time/RFC733/Parsec.hs b/Data/Time/RFC733/Parsec.hs
index 996c94e..6746a3e 100644
--- a/Data/Time/RFC733/Parsec.hs
+++ b/Data/Time/RFC733/Parsec.hs
@@ -44,7 +44,7 @@ date = do day   <- read2
                    <|>
                    liftM (+ 1900) read2
           _     <- char ' '
-          assertGregorianDateIsGood (toInteger year) month day
+          assertGregorianDateIsGood year month day
 
 time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
 time = do tod <- hour
diff --git a/Data/Time/RFC822/Parsec.hs b/Data/Time/RFC822/Parsec.hs
index 0c6762e..5d73ca8 100644
--- a/Data/Time/RFC822/Parsec.hs
+++ b/Data/Time/RFC822/Parsec.hs
@@ -41,7 +41,7 @@ date = do day   <- read2
           _     <- char ' '
           year  <- liftM (+ 1900) read2
           _     <- char ' '
-          assertGregorianDateIsGood (toInteger year) month day
+          assertGregorianDateIsGood year month day
 
 rfc822time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
 rfc822time = do tod <- hour
diff --git a/time-http.cabal b/time-http.cabal
index aeef0f6..051216b 100644
--- a/time-http.cabal
+++ b/time-http.cabal
@@ -27,6 +27,8 @@ Library
         Data.Time.RFC822.Parsec
         Data.Time.RFC1123
         Data.Time.RFC1123.Parsec
+        Data.Time.Asctime
+        Data.Time.Asctime.Parsec
 
     Other-modules:
         Data.Time.HTTP.Common
-- 
2.40.0