{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- |
-- Module      : Data.Time.RFC2822
-- Copyright   : (c) 2011 Hugo Daniel Gomes
--
-- License     : BSD-style
-- Maintainer  : mr.hugo.gomes@gmail.com
-- Stability   : experimental
-- Portability : GHC
--
-- Support for reading and displaying time in the format specified by
-- the RFC2822 <http://www.ietf.org/rfc/rfc2822.txt> section 3.3
--
-- Example of usage:
--
-- > import Data.Time.LocalTime
-- >
-- > showTime :: IO Text
-- > showTime = getZonedTime >>= return . formatTimeRFC2822
-- >
-- > example1 = "Fri, 21 Nov 1997 09:55:06 -0600"
-- > example2 = "Tue, 15 Nov 1994 12:45:26 GMT"
-- > example3 = "Tue, 1 Jul 2003 10:52:37 +0200"
-- > example4 = "Thu, 13 Feb 1969 23:32:54 -0330"
-- > example5 = "Mon, 24 Nov 1997 14:22:01 -0800"
-- > example6 = "Thu,          13\n     Feb\n  1969\n        23:32\n     -0330"
-- > example7 = "Thu,          13\n     Feb\n  1969\n        23:32\n     -0330 (Newfoundland Time)"
-- > example8 = "24 Nov 1997 14:22:01 -0800"
-- > examples = [example1,example2,example3,example4,example5,example6,example7,example8]
-- >
-- > readAll = map parseTimeRFC2822 examples

module Data.Time.RFC2822 (
    -- * Basic type class
    -- $basic
    formatTimeRFC2822, parseTimeRFC2822
) where

import           Control.Applicative

import qualified Data.Attoparsec.Combinator as AC
import           Data.Attoparsec.Text
import qualified Data.Attoparsec.Text       as A
import           Data.Maybe
import           Data.Monoid                ((<>))
import           Data.Monoid.Textual        hiding (foldr, map)
import           Data.String                (fromString)
import           Data.Text                  (Text)
import           Data.Time.Calendar
import           Data.Time.Format
import           Data.Time.LocalTime
import           Data.Time.Util


formatTimeRFC2822 :: (TextualMonoid t) => ZonedTime -> t
formatTimeRFC2822 :: ZonedTime -> t
formatTimeRFC2822 zt :: ZonedTime
zt@(ZonedTime LocalTime
lt TimeZone
z) = String -> t
forall a. IsString a => String -> a
fromString (TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%a, %e %b %Y %T" ZonedTime
zt) t -> t -> t
forall a. Semigroup a => a -> a -> a
<> String -> t
forall a. IsString a => String -> a
fromString String
printZone
  where timeZoneStr :: String
timeZoneStr = TimeZone -> String
timeZoneOffsetString TimeZone
z
        printZone :: String
printZone = if String
timeZoneStr String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== TimeZone -> String
timeZoneOffsetString TimeZone
utc
                    then String
" GMT"
                    else String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
timeZoneStr

formatsRFC2822 :: [Text]
formatsRFC2822 :: [Text]
formatsRFC2822 = do
  Text
day  <- [Text
"%a, ", Text
""]
  Text
time <- [Text
"%T", Text
"%R"]   -- Support for hours:minutes
  Text
zone <- [Text
"GMT", Text
"%z"]
  Text -> [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> [Text]) -> Text -> [Text]
forall a b. (a -> b) -> a -> b
$ Text
day Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"%e %b %Y " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
time Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
zone

parseTimeRFC2822 :: (TextualMonoid t) => t -> Maybe ZonedTime
parseTimeRFC2822 :: t -> Maybe ZonedTime
parseTimeRFC2822 t
t = (Maybe ZonedTime -> Maybe ZonedTime -> Maybe ZonedTime)
-> Maybe ZonedTime -> [Maybe ZonedTime] -> Maybe ZonedTime
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe ZonedTime -> Maybe ZonedTime -> Maybe ZonedTime
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>) Maybe ZonedTime
forall a. Maybe a
Nothing ([Maybe ZonedTime] -> Maybe ZonedTime)
-> [Maybe ZonedTime] -> Maybe ZonedTime
forall a b. (a -> b) -> a -> b
$ (Text -> Maybe ZonedTime) -> [Text] -> [Maybe ZonedTime]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Maybe ZonedTime
forall t. TextualMonoid t => t -> Maybe ZonedTime
parse [Text]
formatsRFC2822
  where parse :: (TextualMonoid t) => t -> Maybe ZonedTime
        parse :: t -> Maybe ZonedTime
parse t
format = TimeLocale -> String -> String -> Maybe ZonedTime
forall t. ParseTime t => TimeLocale -> String -> String -> Maybe t
parseTime TimeLocale
defaultTimeLocale (t -> String
forall t. TextualMonoid t => t -> String
toString' t
format) String
t'

        -- t' is a trimmed t (currently only \n is trimmed)
        -- TODO: trim other white space characters
        t' :: String
        t' :: String
t' = String -> [String]
lines (t -> String
forall t. TextualMonoid t => t -> String
toString' t
t) [String] -> (String -> String) -> String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String
"" String -> String -> String
forall a. [a] -> [a] -> [a]
++)