C.hs

{-# 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 |])
               ]