X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=time-http.git;a=blobdiff_plain;f=Data%2FTime%2FAsctime.hs;h=f8d28ccd80091fb0424c779245aaa6627d50068a;hp=0da530571a329787d82c91136f668b457f51febf;hb=782e6a9;hpb=c6072393ea3d4d19639f410d2010b4815baad9e7 diff --git a/Data/Time/Asctime.hs b/Data/Time/Asctime.hs index 0da5305..f8d28cc 100644 --- a/Data/Time/Asctime.hs +++ b/Data/Time/Asctime.hs @@ -1,65 +1,108 @@ --- |This module is for ANSI C's asctime() format. +{-# LANGUAGE + FlexibleInstances + , MultiParamTypeClasses + , OverloadedStrings + , TemplateHaskell + , UnicodeSyntax + #-} +-- |This module provides functions for ANSI C's asctime() format. -- -- ANSI C's asctime() format looks like: -- --- @Wdy Mon DD HH:MM:SS YYYY@ +-- @Wdy Mon [D]D HH:MM:SS YYYY@ -- -- The exact syntax is as follows: -- --- > date-time ::= wday ' ' month ' ' day ' ' time ' ' year +-- > 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 +-- > day ::= 2DIGIT | SP 1DIGIT -- > time ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT] -- > year ::= 4DIGIT -- -- As you can see, it has no time zone info. "Data.Time.HTTP" will -- treat it as UTC. module Data.Time.Asctime - ( format - , parse + ( Asctime + , asctime ) where - -import qualified Text.Parsec as P - +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.Tagged import Data.Time import Data.Time.Calendar.WeekDate import Data.Time.HTTP.Common -import Data.Time.Asctime.Parsec +import Prelude.Unicode + +-- |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 + +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 --- |Format a 'LocalTime' in the ANSI C's asctime() way. -format :: LocalTime -> String -format localTime +-- |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 - concat [ shortWeekDayName week - , ", " - , shortMonthName month - , " " - , show2 day - , " " - , show2 (todHour timeOfDay) - , ":" - , show2 (todMin timeOfDay) - , ":" - , show2 (floor (todSec timeOfDay)) - , " " - , show4 year - ] + 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 --- |Parse an ANSI C's asctime() format to 'LocalTime'. When the string --- can't be parsed, it returns 'Nothing'. -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 +deriveAttempts [ ([t| LocalTime |], [t| Tagged Asctime Ascii |]) + , ([t| LocalTime |], [t| Tagged Asctime AsciiBuilder |]) + ]