Data/Time/Asctime.hs

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