Data/Time/Asctime.hs

   1 {-# LANGUAGE
   2     FlexibleInstances
   3   , MultiParamTypeClasses
   4   , OverloadedStrings
   5   , UnicodeSyntax
   6   #-}
   7 -- |This module provides functions for ANSI C's asctime() format.
   8 --
   9 -- ANSI C's asctime() format looks like:
  10 --
  11 -- @Wdy Mon [D]D HH:MM:SS YYYY@
  12 --
  13 -- The exact syntax is as follows:
  14 --
  15 -- > date-time ::= wday SP month SP day SP time SP year
  16 -- > wday      ::= "Mon" | "Tue" | "Wed" | "Thu"
  17 -- >             | "Fri" | "Sat" | "Sun"
  18 -- > month     ::= "Jan" | "Feb" | "Mar" | "Apr"
  19 -- >             | "May" | "Jun" | "Jul" | "Aug"
  20 -- >             | "Sep" | "Oct" | "Nov" | "Dec"
  21 -- > day       ::= 2DIGIT | SP 1DIGIT
  22 -- > time      ::= 2DIGIT ':' 2DIGIT [':' 2DIGIT]
  23 -- > year      ::= 4DIGIT
  24 --
  25 -- As you can see, it has no time zone info. "Data.Time.HTTP" will
  26 -- treat it as UTC.
  27 module Data.Time.Asctime
  28     ( Asctime
  29     , asctime
  30     )
  31     where
  32 import Control.Applicative
  33 import Data.Ascii (Ascii, AsciiBuilder)
  34 import qualified Data.Ascii as A
  35 import Data.Attoparsec.Char8
  36 import Data.Convertible.Base
  37 import Data.Monoid.Unicode
  38 import Data.Tagged
  39 import Data.Time
  40 import Data.Time.Calendar.WeekDate
  41 import Data.Time.HTTP.Common
  42 import Prelude.Unicode
  43
  44 -- |The phantom type for conversion between ANSI C's @asctime()@
  45 -- string and 'LocalTime'.
  46 --
  47 -- >>> convertSuccess (LocalTime (ModifiedJulianDay 49662) (TimeOfDay 8 49 37))
  48 -- Tagged "Sun Nov  6 08:49:37 1994"
  49 data Asctime
  50
  51 instance ConvertSuccess LocalTime (Tagged Asctime Ascii) where
  52     {-# INLINE convertSuccess #-}
  53     convertSuccess = (A.fromAsciiBuilder <$>) ∘ cs
  54
  55 instance ConvertAttempt LocalTime (Tagged Asctime Ascii) where
  56     {-# INLINE convertAttempt #-}
  57     convertAttempt = return ∘ cs
  58
  59 instance ConvertSuccess LocalTime (Tagged Asctime AsciiBuilder) where
  60     {-# INLINE convertSuccess #-}
  61     convertSuccess = Tagged ∘ toAsciiBuilder
  62
  63 instance ConvertAttempt LocalTime (Tagged Asctime AsciiBuilder) where
  64     {-# INLINE convertAttempt #-}
  65     convertAttempt = return ∘ cs
  66
  67 instance ConvertAttempt (Tagged Asctime Ascii) LocalTime where
  68     {-# INLINE convertAttempt #-}
  69     convertAttempt = parseAttempt' asctime ∘ untag
  70
  71 -- |Parse an ANSI C's @asctime()@ string.
  72 asctime ∷ Parser LocalTime
  73 asctime = do weekDay ← shortWeekDayNameP
  74              _       ← char ' '
  75              month   ← shortMonthNameP
  76              _       ← char ' '
  77              day     ← read2'
  78              _       ← char ' '
  79              hour    ← read2
  80              _       ← char ':'
  81              minute  ← read2
  82              _       ← char ':'
  83              second  ← read2
  84              _       ← char ' '
  85              year    ← read4
  86
  87              gregDay ← assertGregorianDateIsGood year month day
  88              _       ← assertWeekDayIsGood weekDay gregDay
  89              tod     ← assertTimeOfDayIsGood hour minute second
  90
  91              return (LocalTime gregDay tod)
  92
  93 toAsciiBuilder ∷ LocalTime → AsciiBuilder
  94 toAsciiBuilder localTime
  95     = let (year, month, day) = toGregorian (localDay localTime)
  96           (_, _, week)       = toWeekDate  (localDay localTime)
  97           timeOfDay          = localTimeOfDay localTime
  98       in
  99         shortWeekDayName week
 100         ⊕ A.toAsciiBuilder " "
 101         ⊕ shortMonthName month
 102         ⊕ A.toAsciiBuilder " "
 103         ⊕ show2' day
 104         ⊕ A.toAsciiBuilder " "
 105         ⊕ show2 (todHour timeOfDay)
 106         ⊕ A.toAsciiBuilder ":"
 107         ⊕ show2 (todMin timeOfDay)
 108         ⊕ A.toAsciiBuilder ":"
 109         ⊕ show2 (floor (todSec timeOfDay) ∷ Int)
 110         ⊕ A.toAsciiBuilder " "
 111         ⊕ show4 year