{- |
   Module      :  Text.Parsec.Rfc2822
   Copyright   :  (c) 2007-2019 Peter Simons
   License     :  BSD3

   Maintainer  :  simons@cryp.to
   Stability   :  provisional
   Portability :  portable

   This module provides parsers for the grammar defined in RFC2822,
   \"Internet Message Format\", <http://www.faqs.org/rfcs/rfc2822.html>.
-}

{-# LANGUAGE FlexibleContexts #-}

module Text.Parsec.Rfc2822 where

import Text.Parsec.Rfc2234 hiding ( quoted_pair, quoted_string )

import Control.Monad ( replicateM, guard )
import Data.Char ( ord )
import Data.Functor
import Data.List ( intercalate )
import Data.Maybe ( catMaybes )
import Data.Monoid ( Monoid, mempty )
import Data.Time.Calendar.Compat
import Data.Time.LocalTime
import Text.Parsec hiding ( crlf )

-- Customize hlint ...
{-# ANN module "HLint: ignore Use camelCase" #-}

-- * Useful parser combinators

-- | Return @Nothing@ if the given parser doesn't match. This combinator is
-- included in the latest parsec distribution as @optionMaybe@, but ghc-6.6.1
-- apparently doesn't have it.

maybeOption :: Stream s m Char => ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption :: forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption ParsecT s u m a
p = Maybe a -> ParsecT s u m (Maybe a) -> ParsecT s u m (Maybe a)
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Maybe a
forall a. Maybe a
Nothing ((a -> Maybe a) -> ParsecT s u m a -> ParsecT s u m (Maybe a)
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Maybe a
forall a. a -> Maybe a
Just ParsecT s u m a
p)

-- | @unfold@ @=@ @between (optional cfws) (optional cfws)@

unfold :: Stream s m Char => ParsecT s u m a -> ParsecT s u m a
unfold :: forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold = ParsecT s u m ()
-> ParsecT s u m () -> ParsecT s u m a -> ParsecT s u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws) (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws)

-- | Construct a parser for a message header line from the header's name and a
-- parser for the body.

header :: Stream s m Char => String -> ParsecT s u m a -> ParsecT s u m a
header :: forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
n ParsecT s u m a
p =
  let nameString :: ParsecT s u m ()
nameString = String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString (String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":") in ParsecT s u m ()
-> ParsecT s u m String -> ParsecT s u m a -> ParsecT s u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT s u m ()
forall {u}. ParsecT s u m ()
nameString ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
crlf ParsecT s u m a
p ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" header line")

-- | Like 'header', but allows the obsolete white-space rules.

obs_header :: Stream s m Char => String -> ParsecT s u m a -> ParsecT s u m a
obs_header :: forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
n ParsecT s u m a
p = ParsecT s u m Char
-> ParsecT s u m String -> ParsecT s u m a -> ParsecT s u m a
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT s u m Char
forall {u}. ParsecT s u m Char
nameString ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
crlf ParsecT s u m a
p ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> (String
"obsolete " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" header line")
  where nameString :: ParsecT s u m Char
nameString = String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
n ParsecT s u m () -> ParsecT s u m String -> ParsecT s u m String
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
wsp ParsecT s u m String -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':'

-- ** Primitive Tokens (section 3.2.1)

-- | Match any US-ASCII non-whitespace control character.

no_ws_ctl :: Stream s m Char => ParsecT s u m Char
no_ws_ctl :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
no_ws_ctl = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
1 .. Int
8] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
11, Int
12] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
14 .. Int
31] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
127]))
            ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"US-ASCII non-whitespace control character"

-- | Match any US-ASCII character except for @\r@, @\n@.

text :: Stream s m Char => ParsecT s u m Char
text :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
text = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
1 .. Int
9] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
11, Int
12] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
14 .. Int
127]))
       ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"US-ASCII character (excluding CR and LF)"

-- | Match any of the RFC's \"special\" characters: @()\<\>[]:;\@,.\\\"@.

specials :: Stream s m Char => ParsecT s u m Char
specials :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
specials = String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"()<>[]:;@,.\\\"" ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"one of ()<>[]:;@,.\\\""


-- ** Quoted characters (section 3.2.2)

-- | Match a \"quoted pair\". All characters matched by 'text' may be quoted.
-- Note that the parsers returns /both/ characters, the backslash and the
-- actual content.

quoted_pair :: Stream s m Char => ParsecT s u m String
quoted_pair :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_pair = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_qp ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> do { _ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'; r <- text; return ['\\', r] }
              ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"quoted pair"

-- ** Folding white space and comments (section 3.2.3)

-- | Match \"folding whitespace\". That is any combination of 'wsp' and 'crlf'
-- followed by 'wsp'.

fws :: Stream s m Char => ParsecT s u m String
fws :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws = do r <- ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m String -> ParsecT s u m [String])
-> ParsecT s u m String -> ParsecT s u m [String]
forall a b. (a -> b) -> a -> b
$ [ParsecT s u m String] -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m String
forall {u}. ParsecT s u m String
blanks, ParsecT s u m String
forall {u}. ParsecT s u m String
linebreak]
         return (concat r)
 where
  blanks :: ParsecT s u m String
blanks    = ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
wsp
  linebreak :: ParsecT s u m String
linebreak = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
crlf
                       r2 <- blanks
                       return (r1 ++ r2)

-- | Match any non-whitespace, non-control character except for \"@(@\",
-- \"@)@\", and \"@\\@\". This is used to describe the legal content of
-- 'comment's.
--
-- /Note/: This parser accepts 8-bit characters, even though this is
-- not legal according to the RFC. Unfortunately, 8-bit content in
-- comments has become fairly common in the real world, so we'll just
-- accept the fact.

ctext :: Stream s m Char => ParsecT s u m Char
ctext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
ctext = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
no_ws_ctl ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
33 .. Int
39] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
42 .. Int
91] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
93 .. Int
126] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
128 .. Int
255]))
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"any regular character (excluding '(', ')', and '\\')"

-- | Match a \"comments\". That is any combination of 'ctext', 'quoted_pair's,
-- and 'fws' between brackets. Comments may nest.

comment :: Stream s m Char => ParsecT s u m String
comment :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comment = do _  <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'('
             r1 <- many ccontent
             r2 <- option [] fws
             _  <- char ')'
             return ("(" ++ concat r1 ++ r2 ++ ")")
          ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"comment"
 where
  ccontent :: ParsecT s u m String
ccontent = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String)
-> ParsecT s u m String -> ParsecT s u m String
forall a b. (a -> b) -> a -> b
$ do r1 <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws
                      r2 <- choice [many1 ctext, quoted_pair, comment]
                      return (r1 ++ r2)

-- | Match any combination of 'fws' and 'comments'.

cfws :: Stream s m Char => ParsecT s u m String
cfws :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ([ParsecT s u m String] -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws, ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comment])

-- ** Atom (section 3.2.4)

-- | Match any US-ASCII character except for control characters, 'specials', or
-- space. 'atom' and 'dot_atom' are made up of this.

atext :: Stream s m Char => ParsecT s u m Char
atext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
atext = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alpha ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
"!#$%&'*+-/=?^_`{|}~"
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"US-ASCII character (excluding controls, space, and specials)"

-- | Match one or more 'atext' characters and skip any preceding or trailing
-- 'cfws'.

atom :: Stream s m Char => ParsecT s u m String
atom :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
atom = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
atext ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"atom")

-- | Match 'dot_atom_text' and skip any preceding or trailing 'cfws'.

dot_atom :: Stream s m Char => ParsecT s u m String
dot_atom :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom_text ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dot atom")

-- | Match two or more 'atext's interspersed by dots.

dot_atom_text :: Stream s m Char => ParsecT s u m String
dot_atom_text :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom_text = ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
".") (ParsecT s u m String
-> ParsecT s u m Char -> ParsecT s u m [String]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy1 (ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
atext) (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'.')) ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"dot atom content"


-- ** Quoted strings (section 3.2.5)

-- | Match any non-whitespace, non-control US-ASCII character except for
-- \"@\\@\" and \"@\"@\".

qtext :: Stream s m Char => ParsecT s u m Char
qtext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
qtext = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
no_ws_ctl ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
33] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
35 .. Int
91] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
93 .. Int
126]))
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"US-ASCII character (excluding '\\', and '\"')"

-- | Match either 'qtext' or 'quoted_pair'.

qcontent :: Stream s m Char => ParsecT s u m String
qcontent :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
qcontent = ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
qtext ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_pair ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"quoted string content"

-- | Match any number of 'qcontent' between double quotes. Any 'cfws' preceding
-- or following the \"atom\" is skipped automatically.

quoted_string :: Stream s m Char => ParsecT s u m String
quoted_string :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_string = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (do _  <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
dquote
                           r1 <- many ((++) <$> option [] fws <*> qcontent)
                           r2 <- option [] fws
                           _  <- dquote
                           return ("\"" ++ concat r1 ++ r2 ++ "\""))
                ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"quoted string"


-- * Miscellaneous tokens (section 3.2.6)

-- | Match either 'atom' or 'quoted_string'.

word :: Stream s m Char => ParsecT s u m String
word :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
atom ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_string) ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"word"

-- | Match either one or more 'word's or an 'obs_phrase'.

phrase :: Stream s m Char => ParsecT s u m [String]
phrase :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase = {- many1 word <?> "phrase" <|> -} ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_phrase

-- | Match any non-whitespace, non-control US-ASCII character except for
-- \"@\\@\" and \"@\"@\".

utext :: Stream s m Char => ParsecT s u m Char
utext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
utext = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
no_ws_ctl ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
33 .. Int
126])
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"regular US-ASCII character (excluding '\\', and '\"')"

-- | Match any number of 'utext' tokens.
--
-- \"Unstructured text\" is used in free text fields such as 'subject'.
-- Please note that any comments or whitespace that prefaces or
-- follows the actual 'utext' is /included/ in the returned string.

unstructured :: Stream s m Char => ParsecT s u m String
unstructured :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
unstructured = do r1 <- String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws
                  r2 <- many ((:) <$> utext <*> option [] fws)
                  return (r1 ++ concat r2)
               ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"unstructured text"


-- * Date and Time Specification (section 3.3)

-- | Parse a date and time specification of the form
--
-- >   Thu, 19 Dec 2002 20:35:46 +0200
--
-- where the weekday specification \"@Thu,@\" is optional. The parser
-- returns an appropriate 'ZonedTime'
--
-- TODO: Nor will the 'date_time' parser perform /any/ consistency checking. It
-- will accept
--
-- >>> parseTest date_time "Wed, 30 Apr 2002 13:12 +0100"
-- 2002-04-30 13:12:00 +0100

date_time :: Stream s m Char => ParsecT s u m ZonedTime
date_time :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
date_time = do ParsecT s u m Char -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m DayOfWeek
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
day_of_week ParsecT s u m DayOfWeek -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
','))
               d       <- ParsecT s u m Day
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Day
date
               _       <- fws
               (td, z) <- time
               optional cfws
               return (ZonedTime (LocalTime d td) z)
            ParsecT s u m ZonedTime -> String -> ParsecT s u m ZonedTime
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"date/time specification"

-- | This parser matches a 'day_name' or an 'obs_day_of_week' (optionally
-- wrapped in folding whitespace) and return the appropriate 'DayOfWeek' value.

day_of_week :: Stream s m Char => ParsecT s u m DayOfWeek
day_of_week :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
day_of_week = ParsecT s u m DayOfWeek -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m ()
-> ParsecT s u m ()
-> ParsecT s u m DayOfWeek
-> ParsecT s u m DayOfWeek
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws) (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws) ParsecT s u m DayOfWeek
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
day_name ParsecT s u m DayOfWeek -> String -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"name of a day-of-the-week")
              ParsecT s u m DayOfWeek
-> ParsecT s u m DayOfWeek -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m DayOfWeek
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
obs_day_of_week

-- | This parser recognizes abbreviated weekday names (\"@Mon@\",
-- \"@Tue@\",...).

day_name :: Stream s m Char => ParsecT s u m DayOfWeek
day_name :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
day_name = [ParsecT s u m DayOfWeek] -> ParsecT s u m DayOfWeek
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Mon" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Monday
                  , ParsecT s u m DayOfWeek -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Tue" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Tuesday)
                  , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Wed" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Wednesday
                  , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Thu" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Thursday
                  , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Fri" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Friday
                  , ParsecT s u m DayOfWeek -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Sat" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Saturday)
                  , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Sun" ParsecT s u m () -> DayOfWeek -> ParsecT s u m DayOfWeek
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DayOfWeek
Sunday
                  ]
           ParsecT s u m DayOfWeek -> String -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"name of a day-of-the-week"

-- | This parser will match a date of the form \"@dd:mm:yyyy@\" and return a
-- tripple of the form (Int,Month,Int) - corresponding to (year,month,day).

date :: Stream s m Char => ParsecT s u m Day
date :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Day
date = do d <- ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
day
          m <- month
          y <- year
          return (fromGregorian (fromIntegral y) m d)
       ParsecT s u m Day -> String -> ParsecT s u m Day
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"date specification"

-- | This parser will match a four digit number and return its integer value.
-- No range checking is performed.

year :: Stream s m Char => ParsecT s u m Int
year :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
year = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT s u m String -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a.
Int -> ParsecT s u m a -> ParsecT s u m [a]
manyN Int
4 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"year"

-- | This parser will match a 'month_name', optionally wrapped in folding
-- whitespace, or an 'obs_month' and return its 'Month' value.

month :: Stream s m Char => ParsecT s u m Int
month :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
month = ParsecT s u m Int -> ParsecT s u m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m ()
-> ParsecT s u m () -> ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws) (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws) ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
month_name ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"month name") ParsecT s u m Int -> ParsecT s u m Int -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_month


-- | This parser will the abbreviated month names (\"@Jan@\", \"@Feb@\", ...)
-- and return the appropriate 'Int' value in the range of (1,12).

month_name :: Stream s m Char => ParsecT s u m Int
month_name :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
month_name = [ParsecT s u m Int] -> ParsecT s u m Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Jan") ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
1
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Feb" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
2
                    , ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Mar") ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
3
                    , ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Apr") ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
4
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"May" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
5
                    , ParsecT s u m () -> ParsecT s u m ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Jun") ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
6
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Jul" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
7
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Aug" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
8
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Sep" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
9
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Oct" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
10
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Nov" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
11
                    , String -> ParsecT s u m ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
caseString String
"Dec" ParsecT s u m () -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
12
                    ]
             ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"month name"

-- Internal helper function: match a 1 or 2-digit number (day of month).

day_of_month :: Stream s m Char => ParsecT s u m Int
day_of_month :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
day_of_month = do r <- (String -> Int) -> ParsecT s u m String -> ParsecT s u m Int
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall a. Read a => String -> a
read (Int -> Int -> ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a.
Int -> Int -> ParsecT s u m a -> ParsecT s u m [a]
manyNtoM Int
1 Int
2 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
                  guard (r >= 1 && r <= 31)
                  return r

-- | Match a 1 or 2-digit number (day of month), recognizing both standard and
-- obsolete folding syntax.

day :: Stream s m Char => ParsecT s u m Int
day :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
day = ParsecT s u m Int -> ParsecT s u m Int
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_day ParsecT s u m Int -> ParsecT s u m Int -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
day_of_month ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"day"

-- | This parser will match a 'time_of_day' specification followed by a 'zone'.
-- It returns the tuple (TimeOfDay,Int) corresponding to the return values of
-- either parser.

time :: Stream s m Char => ParsecT s u m (TimeOfDay, TimeZone)
time :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (TimeOfDay, TimeZone)
time = do t <- ParsecT s u m TimeOfDay
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m TimeOfDay
time_of_day
          _ <- fws
          z <- zone
          return (t, z)
       ParsecT s u m (TimeOfDay, TimeZone)
-> String -> ParsecT s u m (TimeOfDay, TimeZone)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"time and zone specification"

-- | This parser will match a time-of-day specification of \"@hh:mm@\" or
-- \"@hh:mm:ss@\" and return the corrsponding time as a 'TimeOfDay'.
--
-- >>> parseTest (time_of_day <* eof) "12:03:23"
-- 12:03:23
-- >>> parseTest (time_of_day <* eof) "99:99:99"
-- parse error at (line 1, column 3):unknown parse error

time_of_day :: Stream s m Char => ParsecT s u m TimeOfDay
time_of_day :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m TimeOfDay
time_of_day = do h <- ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
hour
                 _ <- char ':'
                 m <- minute
                 s <- option 0 (char ':' *> second)
                 return (TimeOfDay h m (fromIntegral s))
              ParsecT s u m TimeOfDay -> String -> ParsecT s u m TimeOfDay
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"time specification"

-- | This parser matches a two-digit number in the range (0,24) and returns its
-- integer value.
--
-- >>> parseTest hour "034"
-- 3
-- >>> parseTest hour "99"
-- parse error at (line 1, column 3):unknown parse error

hour :: Stream s m Char => ParsecT s u m Int
hour :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
hour = do r <- (String -> Int) -> ParsecT s u m String -> ParsecT s u m Int
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall a. Read a => String -> a
read (Int -> ParsecT s u m Char -> ParsecT s u m String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
          guard (r >= 0 && r <= 24)
          return r
       ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"hour"

-- | This parser will match a two-digit number in the range (0,60) and return
-- its integer value.
--
-- >>> parseTest minute "34"
-- 34
-- >>> parseTest minute "61"
-- parse error at (line 1, column 3):unknown parse error
-- >>> parseTest (minute <* eof) "034"
-- parse error at (line 1, column 3):
-- unexpected '4'
-- expecting end of input

minute :: Stream s m Char => ParsecT s u m Int
minute :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
minute = do r <- (String -> Int) -> ParsecT s u m String -> ParsecT s u m Int
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Int
forall a. Read a => String -> a
read (Int -> ParsecT s u m Char -> ParsecT s u m String
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)
            guard (r >= 0 && r <= 60)
            return r
         ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"minute"

-- | This parser will match a two-digit number in the range (0,60) and return
-- its integer value.
--
-- >>> parseTest second "34"
-- 34

second :: Stream s m Char => ParsecT s u m Int
second :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
second = ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
minute ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"second"

-- | This parser will match a timezone specification of the form \"@+hhmm@\" or
-- \"@-hhmm@\" and return the zone's offset to UTC in seconds as an integer.
-- 'obs_zone' is matched as well.

zone :: Stream s m Char => ParsecT s u m TimeZone
zone :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m TimeZone
zone = do sign <- [ParsecT s u m Int] -> ParsecT s u m Int
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'+' ParsecT s u m Char -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int
1, Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'-' ParsecT s u m Char -> Int -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (-Int
1)]
          h    <- hour
          m    <- minute
          return (minutesToTimeZone (sign * ((h * 60) + m)))
       ParsecT s u m TimeZone
-> ParsecT s u m TimeZone -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m TimeZone
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m TimeZone
obs_zone

-- * Address Specification (section 3.4)

-- | A NameAddr is composed of an optional realname a mandatory e-mail
-- 'address'.

data NameAddr = NameAddr { NameAddr -> Maybe String
nameAddr_name :: Maybe String
                         , NameAddr -> String
nameAddr_addr :: String
                         }
  deriving (Int -> NameAddr -> String -> String
[NameAddr] -> String -> String
NameAddr -> String
(Int -> NameAddr -> String -> String)
-> (NameAddr -> String)
-> ([NameAddr] -> String -> String)
-> Show NameAddr
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> NameAddr -> String -> String
showsPrec :: Int -> NameAddr -> String -> String
$cshow :: NameAddr -> String
show :: NameAddr -> String
$cshowList :: [NameAddr] -> String -> String
showList :: [NameAddr] -> String -> String
Show,NameAddr -> NameAddr -> Bool
(NameAddr -> NameAddr -> Bool)
-> (NameAddr -> NameAddr -> Bool) -> Eq NameAddr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NameAddr -> NameAddr -> Bool
== :: NameAddr -> NameAddr -> Bool
$c/= :: NameAddr -> NameAddr -> Bool
/= :: NameAddr -> NameAddr -> Bool
Eq)

-- | Parse a single 'mailbox' or an address 'group' and return the address(es).

address :: Stream s m Char => ParsecT s u m [NameAddr]
address :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address = ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (NameAddr -> [NameAddr]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return (NameAddr -> [NameAddr])
-> ParsecT s u m NameAddr -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox) ParsecT s u m [NameAddr]
-> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
group ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address"

-- | Parse a 'name_addr' or an 'addr_spec' and return the address.

mailbox :: Stream s m Char => ParsecT s u m NameAddr
mailbox :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox = ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
name_addr ParsecT s u m NameAddr
-> ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (String -> NameAddr)
-> ParsecT s u m String -> ParsecT s u m NameAddr
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe String -> String -> NameAddr
NameAddr Maybe String
forall a. Maybe a
Nothing) ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
addr_spec ParsecT s u m NameAddr -> String -> ParsecT s u m NameAddr
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"mailbox"

-- | Parse an 'angle_addr', optionally prefaced with a 'display_name', and
-- return the address.

name_addr :: Stream s m Char => ParsecT s u m NameAddr
name_addr :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
name_addr = (Maybe String -> String -> NameAddr
NameAddr (Maybe String -> String -> NameAddr)
-> ParsecT s u m (Maybe String)
-> ParsecT s u m (String -> NameAddr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String -> ParsecT s u m (Maybe String)
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
display_name ParsecT s u m (String -> NameAddr)
-> ParsecT s u m String -> ParsecT s u m NameAddr
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
angle_addr) ParsecT s u m NameAddr -> String -> ParsecT s u m NameAddr
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"name address"


-- | Parse an 'angle_addr' or an 'obs_angle_addr' and return the address.

angle_addr :: Stream s m Char => ParsecT s u m String
angle_addr :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
angle_addr = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m String
-> ParsecT s u m String
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<') (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'>') ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
addr_spec) ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"angle address")
             ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_angle_addr

-- | Parse a \"group\" of addresses. That is a 'display_name', followed by a
-- colon, optionally followed by a 'mailbox_list', followed by a semicolon. The
-- found address(es) are returned - what may be none. Here is an example:
--
-- >>> parse group "" "my group: user1@example.org, user2@example.org;"
-- Right [NameAddr {nameAddr_name = Nothing, nameAddr_addr = "user1@example.org"},NameAddr {nameAddr_name = Nothing, nameAddr_addr = "user2@example.org"}]

group :: Stream s m Char => ParsecT s u m [NameAddr]
group :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
group = do _ <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
display_name
           _ <- char ':'
           r <- option [] mailbox_list
           _ <- unfold $ char ';'
           return r
        ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address group"

-- | Parse and return a 'phrase'.

display_name :: Stream s m Char => ParsecT s u m String
display_name :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
display_name = ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall a b. (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [String] -> String
unwords ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"display name"

-- | Parse a list of 'mailbox' addresses, every two addresses being separated
-- by a comma, and return the list of found address(es).

mailbox_list :: Stream s m Char => ParsecT s u m [NameAddr]
mailbox_list :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list = ParsecT s u m NameAddr
-> ParsecT s u m Char -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"mailbox list"

-- | Parse a list of 'address' addresses, every two addresses being separated
-- by a comma, and return the list of found address(es).

address_list :: Stream s m Char => ParsecT s u m [NameAddr]
address_list :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list = [[NameAddr]] -> [NameAddr]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[NameAddr]] -> [NameAddr])
-> ParsecT s u m [[NameAddr]] -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
-> ParsecT s u m Char -> ParsecT s u m [[NameAddr]]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
sepBy ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',') ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address list"


-- ** Addr-spec specification (section 3.4.1)

-- | Parse an \"address specification\". That is a 'local_part', followed by an
-- \"@\@@\" character, followed by a 'domain'. Return the complete address as
-- 'String', ignoring any whitespace or any comments.

addr_spec :: Stream s m Char => ParsecT s u m String
addr_spec :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
addr_spec = do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
local_part
               _  <- char '@'
               r2 <- domain
               return (r1 ++ "@" ++ r2)
            ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address specification"

-- | Parse and return a \"local part\" of an 'addr_spec'. That is either a
-- 'dot_atom' or a 'quoted_string'.

local_part :: Stream s m Char => ParsecT s u m String
local_part :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
local_part = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_local_part ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_string ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address' local part"

-- | Parse and return a \"domain part\" of an 'addr_spec'. That is either a
-- 'dot_atom' or a 'domain_literal'.

domain :: Stream s m Char => ParsecT s u m String
domain :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
domain = ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_domain ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
domain_literal ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"address' domain part"

-- | Parse a \"domain literal\". That is a \"@[@\" character, followed by any
-- amount of 'dcontent', followed by a terminating \"@]@\" character. The
-- complete string is returned verbatim.

domain_literal :: Stream s m Char => ParsecT s u m String
domain_literal :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
domain_literal = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (do r <- ParsecT s u m Char
-> ParsecT s u m Char
-> ParsecT s u m [String]
-> ParsecT s u m [String]
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'[') (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws ParsecT s u m () -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
']') (ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
fws ParsecT s u m () -> ParsecT s u m String -> ParsecT s u m String
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dcontent))
                            return ("[" ++ concat r ++ "]"))
                 ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"domain literal"

-- | Parse and return any characters that are legal in a 'domain_literal'. That
-- is 'dtext' or a 'quoted_pair'.

dcontent :: Stream s m Char => ParsecT s u m String
dcontent :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dcontent = ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
dtext ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
quoted_pair ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"domain literal content"

-- | Parse and return any ASCII characters except \"@[@\", \"@]@\", and
-- \"@\\@\".

dtext :: Stream s m Char => ParsecT s u m Char
dtext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
dtext = ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
no_ws_ctl ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
33 .. Int
90] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
94 .. Int
126]))
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"any ASCII character (excluding '[', ']', and '\\')"


-- * Overall message syntax (section 3.5)

-- | This data type represents a parsed Internet Message as defined in this
-- RFC. It consists of an arbitrary number of header lines, represented in the
-- 'Field' data type, and a message body, which may be empty.

data GenericMessage a = Message [Field] a deriving Int -> GenericMessage a -> String -> String
[GenericMessage a] -> String -> String
GenericMessage a -> String
(Int -> GenericMessage a -> String -> String)
-> (GenericMessage a -> String)
-> ([GenericMessage a] -> String -> String)
-> Show (GenericMessage a)
forall a. Show a => Int -> GenericMessage a -> String -> String
forall a. Show a => [GenericMessage a] -> String -> String
forall a. Show a => GenericMessage a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: forall a. Show a => Int -> GenericMessage a -> String -> String
showsPrec :: Int -> GenericMessage a -> String -> String
$cshow :: forall a. Show a => GenericMessage a -> String
show :: GenericMessage a -> String
$cshowList :: forall a. Show a => [GenericMessage a] -> String -> String
showList :: [GenericMessage a] -> String -> String
Show

-- | Parse a complete message as defined by this RFC and it broken down into
-- the separate header fields and the message body. Header lines, which contain
-- syntax errors, will not cause the parser to abort. Rather, these headers
-- will appear as 'OptionalField's (which are unparsed) in the resulting
-- 'Message'. A message must be really, really badly broken for this parser to
-- fail.
--
-- This behaviour was chosen because it is impossible to predict what
-- the user of this module considers to be a fatal error;
-- traditionally, parsers are very forgiving when it comes to Internet
-- messages.
--
-- If you want to implement a really strict parser, you'll have to put
-- the appropriate parser together yourself. You'll find that this is
-- rather easy to do. Refer to the 'fields' parser for further details.

message :: (Monoid s, Stream s m Char) => ParsecT s u m (GenericMessage s)
message :: forall s (m :: * -> *) u.
(Monoid s, Stream s m Char) =>
ParsecT s u m (GenericMessage s)
message = [Field] -> s -> GenericMessage s
forall a. [Field] -> a -> GenericMessage a
Message ([Field] -> s -> GenericMessage s)
-> ParsecT s u m [Field] -> ParsecT s u m (s -> GenericMessage s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [Field]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [Field]
fields ParsecT s u m (s -> GenericMessage s)
-> ParsecT s u m s -> ParsecT s u m (GenericMessage s)
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> s -> ParsecT s u m s -> ParsecT s u m s
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option s
forall a. Monoid a => a
mempty (ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
crlf ParsecT s u m String -> ParsecT s u m s -> ParsecT s u m s
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m s
forall s (m :: * -> *) u. (Monoid s, Monad m) => ParsecT s u m s
body)


-- | A message body is just an unstructured sequence of characters.

body :: (Monoid s, Monad m) => ParsecT s u m s
body :: forall s (m :: * -> *) u. (Monoid s, Monad m) => ParsecT s u m s
body = do v <- ParsecT s u m s
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput
          setInput mempty
          return v

-- * Field definitions (section 3.6)

-- | This data type represents any of the header fields defined in this RFC.
-- Each of the various instances contains with the return value of the
-- corresponding parser.

data Field = OptionalField       String String
           | From                [NameAddr]
           | Sender              NameAddr
           | ReturnPath          String
           | ReplyTo             [NameAddr]
           | To                  [NameAddr]
           | Cc                  [NameAddr]
           | Bcc                 [NameAddr]
           | MessageID           String
           | InReplyTo           [String]
           | References          [String]
           | Subject             String
           | Comments            String
           | Keywords            [[String]]
           | Date                ZonedTime
           | ResentDate          ZonedTime
           | ResentFrom          [NameAddr]
           | ResentSender        NameAddr
           | ResentTo            [NameAddr]
           | ResentCc            [NameAddr]
           | ResentBcc           [NameAddr]
           | ResentMessageID     String
           | ResentReplyTo       [NameAddr]
           | Received            ([(String,String)], ZonedTime)
           | ObsReceived         [(String,String)]
  deriving (Int -> Field -> String -> String
[Field] -> String -> String
Field -> String
(Int -> Field -> String -> String)
-> (Field -> String) -> ([Field] -> String -> String) -> Show Field
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Field -> String -> String
showsPrec :: Int -> Field -> String -> String
$cshow :: Field -> String
show :: Field -> String
$cshowList :: [Field] -> String -> String
showList :: [Field] -> String -> String
Show)

-- | This parser will parse an arbitrary number of header fields as defined in
-- this RFC. For each field, an appropriate 'Field' value is created, all of
-- them making up the 'Field' list that this parser returns.
--
-- If you look at the implementation of this parser, you will find
-- that it uses Parsec's 'try' modifier around /all/ of the fields.
-- The idea behind this is that fields, which contain syntax errors,
-- fall back to the catch-all 'optional_field'. Thus, this parser will
-- hardly ever return a syntax error -- what conforms with the idea
-- that any message that can possibly be accepted /should/ be.

fields :: Stream s m Char => ParsecT s u m [Field]
fields :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [Field]
fields = ParsecT s u m Field -> ParsecT s u m [Field]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Field -> ParsecT s u m [Field])
-> ParsecT s u m Field -> ParsecT s u m [Field]
forall a b. (a -> b) -> a -> b
$ [ParsecT s u m Field] -> ParsecT s u m Field
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
From ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
from)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (NameAddr -> Field
Sender (NameAddr -> Field)
-> ParsecT s u m NameAddr -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
sender)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
ReturnPath (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
return_path)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ReplyTo ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
reply_to)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
To ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
to)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
Cc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
cc)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
Bcc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
bcc)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
MessageID (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
message_id)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([String] -> Field
InReplyTo ([String] -> Field)
-> ParsecT s u m [String] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
in_reply_to)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([String] -> Field
References ([String] -> Field)
-> ParsecT s u m [String] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
references)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
Subject (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
subject)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
Comments (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comments)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([[String]] -> Field
Keywords ([[String]] -> Field)
-> ParsecT s u m [[String]] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [[String]]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [[String]]
keywords)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ZonedTime -> Field
Date (ZonedTime -> Field)
-> ParsecT s u m ZonedTime -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
orig_date)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ZonedTime -> Field
ResentDate (ZonedTime -> Field)
-> ParsecT s u m ZonedTime -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
resent_date)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentFrom ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_from)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (NameAddr -> Field
ResentSender (NameAddr -> Field)
-> ParsecT s u m NameAddr -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
resent_sender)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentTo ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_to)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentCc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_cc)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentBcc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_bcc)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
ResentMessageID (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
resent_msg_id)
                       , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (([(String, String)], ZonedTime) -> Field
Received (([(String, String)], ZonedTime) -> Field)
-> ParsecT s u m ([(String, String)], ZonedTime)
-> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m ([(String, String)], ZonedTime)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ([(String, String)], ZonedTime)
received)
                       , (String -> String -> Field) -> (String, String) -> Field
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Field
OptionalField ((String, String) -> Field)
-> ParsecT s u m (String, String) -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m (String, String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
optional_field  -- catch all
                       ]

-- ** The origination date field (section 3.6.1)

-- | Parse a \"@Date:@\" header line and return the date it contains a
-- 'CalendarTime'.

orig_date :: Stream s m Char => ParsecT s u m ZonedTime
orig_date :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
orig_date = String -> ParsecT s u m ZonedTime -> ParsecT s u m ZonedTime
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Date" ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
date_time


-- ** Originator fields (section 3.6.2)

-- | Parse a \"@From:@\" header line and return the 'mailbox_list' address(es)
-- contained in it.

from :: Stream s m Char => ParsecT s u m [NameAddr]
from :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
from = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"From" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list

-- | Parse a \"@Sender:@\" header line and return the 'mailbox' address
-- contained in it.

sender :: Stream s m Char => ParsecT s u m NameAddr
sender :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
sender = String -> ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Sender" ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox

-- | Parse a \"@Reply-To:@\" header line and return the 'address_list'
-- address(es) contained in it.

reply_to :: Stream s m Char => ParsecT s u m [NameAddr]
reply_to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
reply_to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Reply-To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list


-- ** Destination address fields (section 3.6.3)

-- | Parse a \"@To:@\" header line and return the 'address_list' address(es)
-- contained in it.

to :: Stream s m Char => ParsecT s u m [NameAddr]
to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a \"@Cc:@\" header line and return the 'address_list' address(es)
-- contained in it.

cc :: Stream s m Char => ParsecT s u m [NameAddr]
cc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
cc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Cc" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a \"@Bcc:@\" header line and return the 'address_list' address(es)
-- contained in it.

bcc :: Stream s m Char => ParsecT s u m [NameAddr]
bcc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
bcc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Bcc" (ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list ParsecT s u m [NameAddr]
-> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m () -> [NameAddr] -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))

-- ** Identification fields (section 3.6.4)

-- | Parse a \"@Message-Id:@\" header line and return the 'msg_id' contained in
-- it.

message_id :: Stream s m Char => ParsecT s u m String
message_id :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
message_id = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Message-ID" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id

-- | Parse a \"@In-Reply-To:@\" header line and return the list of 'msg_id's
-- contained in it.

in_reply_to :: Stream s m Char => ParsecT s u m [String]
in_reply_to :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
in_reply_to = String -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"In-Reply-To" (ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id)

-- | Parse a \"@References:@\" header line and return the list of 'msg_id's
-- contained in it.

references :: Stream s m Char => ParsecT s u m [String]
references :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
references = String -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"References" (ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id)

-- | Parse a \"@message ID:@\" and return it. A message ID is almost identical
-- to an 'angle_addr', but with stricter rules about folding and whitespace.

msg_id :: Stream s m Char => ParsecT s u m String
msg_id :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (do _   <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
                    idl <- id_left
                    _   <- char '@'
                    idr <- id_right
                    _   <- char '>'
                    return ("<" ++ idl ++ "@" ++ idr ++ ">")
                )
         ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"message ID"

-- | Parse a \"left ID\" part of a 'msg_id'. This is almost identical to the
-- 'local_part' of an e-mail address, but with stricter rules about folding and
-- whitespace.

id_left :: Stream s m Char => ParsecT s u m String
id_left :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
id_left = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom_text ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
no_fold_quote ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"left part of an message ID"

-- | Parse a \"right ID\" part of a 'msg_id'. This is almost identical to the
-- 'domain' of an e-mail address, but with stricter rules about folding and
-- whitespace.

id_right :: Stream s m Char => ParsecT s u m String
id_right :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
id_right = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
dot_atom_text ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
no_fold_literal ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"right part of an message ID"

-- | Parse one or more occurrences of 'qtext' or 'quoted_pair' and return the
-- concatenated string. This makes up the 'id_left' of a 'msg_id'.

no_fold_quote :: Stream s m Char => ParsecT s u m String
no_fold_quote :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
no_fold_quote = do _ <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
dquote
                   r <- many (many1 qtext <|> quoted_pair)
                   _ <- dquote
                   return ("\"" ++ concat r ++ "\"")
                ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"non-folding quoted string"

-- | Parse one or more occurrences of 'dtext' or 'quoted_pair' and return the
-- concatenated string. This makes up the 'id_right' of a 'msg_id'.

no_fold_literal :: Stream s m Char => ParsecT s u m String
no_fold_literal :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
no_fold_literal = do _ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'['
                     r <- many (many1 dtext <|> quoted_pair)
                     _ <- char ']'
                     return ("[" ++ concat r ++ "]")
                  ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"non-folding domain literal"


-- ** Informational fields (section 3.6.5)

-- | Parse a \"@Subject:@\" header line and return its contents verbatim.
-- Please note that all whitespace and/or comments are preserved, i.e. the
-- result of parsing @\"Subject: foo\"@ is @\" foo\"@, not @\"foo\"@.

subject :: Stream s m Char => ParsecT s u m String
subject :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
subject = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Subject" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
unstructured

-- | Parse a \"@Comments:@\" header line and return its contents verbatim.
-- Please note that all whitespace and/or comments are preserved, i.e. the
-- result of parsing @\"Comments: foo\"@ is @\" foo\"@, not @\"foo\"@.

comments :: Stream s m Char => ParsecT s u m String
comments :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
comments = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Comments" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
unstructured

-- | Parse a \"@Keywords:@\" header line and return the list of 'phrase's
-- found. Please not that each phrase is again a list of 'atom's, as returned
-- by the 'phrase' parser.

keywords :: Stream s m Char => ParsecT s u m [[String]]
keywords :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [[String]]
keywords = String -> ParsecT s u m [[String]] -> ParsecT s u m [[String]]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Keywords" ((:) ([String] -> [[String]] -> [[String]])
-> ParsecT s u m [String]
-> ParsecT s u m ([[String]] -> [[String]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase ParsecT s u m ([[String]] -> [[String]])
-> ParsecT s u m [[String]] -> ParsecT s u m [[String]]
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m [String] -> ParsecT s u m [[String]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
',' ParsecT s u m Char
-> ParsecT s u m [String] -> ParsecT s u m [String]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase))


-- ** Resent fields (section 3.6.6)

-- | Parse a \"@Resent-Date:@\" header line and return the date it contains as
-- 'ZonedTime'.

resent_date :: Stream s m Char => ParsecT s u m ZonedTime
resent_date :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
resent_date = String -> ParsecT s u m ZonedTime -> ParsecT s u m ZonedTime
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-Date" ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
date_time

-- | Parse a \"@Resent-From:@\" header line and return the 'mailbox_list'
-- address(es) contained in it.

resent_from :: Stream s m Char => ParsecT s u m [NameAddr]
resent_from :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_from = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-From" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list


-- | Parse a \"@Resent-Sender:@\" header line and return the 'mailbox_list'
-- address(es) contained in it.

resent_sender :: Stream s m Char => ParsecT s u m NameAddr
resent_sender :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
resent_sender = String -> ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-Sender" ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox


-- | Parse a \"@Resent-To:@\" header line and return the 'mailbox' address
-- contained in it.

resent_to :: Stream s m Char => ParsecT s u m [NameAddr]
resent_to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a \"@Resent-Cc:@\" header line and return the 'address_list'
-- address(es) contained in it.

resent_cc :: Stream s m Char => ParsecT s u m [NameAddr]
resent_cc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_cc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-Cc" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a \"@Resent-Bcc:@\" header line and return the 'address_list'
-- address(es) contained in it. (This list may be empty.)

resent_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
resent_bcc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
resent_bcc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-Bcc" (ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list ParsecT s u m [NameAddr]
-> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m () -> [NameAddr] -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))
             ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"Resent-Bcc: header line"

-- | Parse a \"@Resent-Message-ID:@\" header line and return the 'msg_id'
-- contained in it.

resent_msg_id :: Stream s m Char => ParsecT s u m String
resent_msg_id :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
resent_msg_id = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Resent-Message-ID" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id


-- ** Trace fields (section 3.6.7)

return_path :: Stream s m Char => ParsecT s u m String
return_path :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
return_path = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Return-Path" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
path

path :: Stream s m Char => ParsecT s u m String
path :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
path = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (  ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (do
                       _ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
                       r <- option "" addr_spec
                       _ <- char '>'
                       return ("<" ++ r ++ ">")
                     )
             ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_path
              )
       ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"return path spec"

received :: Stream s m Char => ParsecT s u m ([(String, String)], ZonedTime)
received :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ([(String, String)], ZonedTime)
received = String
-> ParsecT s u m ([(String, String)], ZonedTime)
-> ParsecT s u m ([(String, String)], ZonedTime)
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Received" (ParsecT s u m ([(String, String)], ZonedTime)
 -> ParsecT s u m ([(String, String)], ZonedTime))
-> ParsecT s u m ([(String, String)], ZonedTime)
-> ParsecT s u m ([(String, String)], ZonedTime)
forall a b. (a -> b) -> a -> b
$ do r1 <- ParsecT s u m [(String, String)]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [(String, String)]
name_val_list
                                  _  <- char ';'
                                  r2 <- date_time
                                  return (r1, r2)


name_val_list :: Stream s m Char => ParsecT s u m [(String, String)]
name_val_list :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [(String, String)]
name_val_list = ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m ()
-> ParsecT s u m [(String, String)]
-> ParsecT s u m [(String, String)]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ParsecT s u m (String, String) -> ParsecT s u m [(String, String)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m (String, String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
name_val_pair
                ParsecT s u m [(String, String)]
-> String -> ParsecT s u m [(String, String)]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"list of name/value pairs"

name_val_pair :: Stream s m Char => ParsecT s u m (String, String)
name_val_pair :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
name_val_pair = do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
item_name
                   _  <- cfws
                   r2 <- item_value
                   return (r1, r2)
                ParsecT s u m (String, String)
-> String -> ParsecT s u m (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"a name/value pair"

item_name :: Stream s m Char => ParsecT s u m String
item_name :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
item_name = do r1 <- ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
alpha
               r2 <- many $ choice [char '-', alpha, digit]
               return (r1 : r2)
            ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"name of a name/value pair"

item_value :: Stream s m Char => ParsecT s u m String
item_value :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
item_value = [ParsecT s u m String] -> ParsecT s u m String
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> String)
-> ParsecT s u m [String] -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
angle_addr)
                    , ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
addr_spec
                    , ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
domain
                    , ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id
                    , ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
atom
                    ]
             ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"value of a name/value pair"

-- ** Optional fields (section 3.6.8)

-- | Parse an arbitrary header field and return a tuple containing the
-- 'field_name' and 'unstructured' text of the header. The name will /not/
-- contain the terminating colon.

{-# ANN optional_field "HLint: ignore Reduce duplication" #-}

optional_field :: Stream s m Char => ParsecT s u m (String, String)
optional_field :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
optional_field = do n <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
field_name
                    _ <- char ':'
                    b <- unstructured
                    _ <- crlf
                    return (n, b)
                 ParsecT s u m (String, String)
-> String -> ParsecT s u m (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"optional (unspecified) header line"

-- | Parse and return an arbitrary header field name. That is one or more
-- 'ftext' characters.

field_name :: Stream s m Char => ParsecT s u m String
field_name :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
field_name = ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
ftext ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"header line name"

-- | Match and return any ASCII character except for control characters,
-- whitespace, and \"@:@\".

ftext :: Stream s m Char => ParsecT s u m Char
ftext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
ftext = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
33 .. Int
57] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
59 .. Int
126]))
        ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"character (excluding controls, space, and ':')"


-- * Miscellaneous obsolete tokens (section 4.1)

-- | Match the obsolete \"quoted pair\" syntax, which - unlike 'quoted_pair' -
-- allowed /any/ ASCII character to be specified when quoted. The parser will
-- return both, the backslash and the actual character.

obs_qp :: Stream s m Char => ParsecT s u m String
obs_qp :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_qp = do _ <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\'
            c <- satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Int
0 .. Int
127])
            return ['\\', c]
         ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"any quoted US-ASCII character"

-- | Match the obsolete \"text\" syntax, which - unlike 'text' - allowed
-- \"carriage returns\" and \"linefeeds\". This is really weird; you better
-- consult the RFC for details. The parser will return the complete string,
-- including those special characters.

obs_text :: Stream s m Char => ParsecT s u m String
obs_text :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_text = do r1 <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
lf
              r2 <- many cr
              r3 <- many $ do r4 <- obs_char
                              r5 <- many lf
                              r6 <- many cr
                              return (r4 : (r5 ++ r6))
              return (r1 ++ r2 ++ concat r3)

-- | Match and return the obsolete \"char\" syntax, which - unlike 'character'
-- - did not allow \"carriage return\" and \"linefeed\".

obs_char :: Stream s m Char => ParsecT s u m Char
obs_char :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
obs_char = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy (\Char
c -> Char -> Int
ord Char
c Int -> [Int] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ([Int
0 .. Int
9] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
11, Int
12] [Int] -> [Int] -> [Int]
forall a. [a] -> [a] -> [a]
++ [Int
14 .. Int
127]))
           ParsecT s u m Char -> String -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"any ASCII character except CR and LF"

-- | Match and return the obsolete \"utext\" syntax, which is identical to
-- 'obs_text'.

obs_utext :: Stream s m Char => ParsecT s u m String
obs_utext :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_utext = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_text

-- | Match the obsolete \"phrase\" syntax, which - unlike 'phrase' - allows
-- dots between tokens.

obs_phrase :: Stream s m Char => ParsecT s u m [String]
obs_phrase :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_phrase = do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word
                r2 <- many $ choice [ word
                                    , string "."
                                    , cfws $> []
                                    ]
                return (r1 : filter (/= []) r2)

-- | Match a \"phrase list\" syntax and return the list of 'String's that make
-- up the phrase. In contrast to a 'phrase', the 'obs_phrase_list' separates
-- the individual words by commas. This syntax is - as you will have guessed -
-- obsolete.

obs_phrase_list :: Stream s m Char => ParsecT s u m [String]
obs_phrase_list :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_phrase_list = do r1 <- ParsecT s u m [String] -> ParsecT s u m [[String]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m [String] -> ParsecT s u m [[String]])
-> ParsecT s u m [String] -> ParsecT s u m [[String]]
forall a b. (a -> b) -> a -> b
$ do r <- [String] -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option [] ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase
                                      _ <- unfold $ char ','
                                      return (filter (/= []) r)
                     r2 <- option [] phrase
                     return (concat r1 ++ r2)
                  ParsecT s u m [String]
-> ParsecT s u m [String] -> ParsecT s u m [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase


-- * Obsolete folding white space (section 4.2)

-- | Parse and return an \"obsolete fws\" token. That is at least one 'wsp'
-- character, followed by an arbitrary number (including zero) of 'crlf'
-- followed by at least one more 'wsp' character.

obs_fws :: Stream s m Char => ParsecT s u m String
obs_fws :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_fws = do r1 <- ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
wsp
             r2 <- many $ do r3 <- crlf
                             r4 <- many1 wsp
                             return (r3 ++ r4)
             return (r1 ++ concat r2)

-- * Obsolete Date and Time (section 4.3)

-- | Parse a 'day_name' but allow for the obsolete folding syntax. TODO

obs_day_of_week :: Stream s m Char => ParsecT s u m DayOfWeek
obs_day_of_week :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
obs_day_of_week = ParsecT s u m DayOfWeek -> ParsecT s u m DayOfWeek
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold ParsecT s u m DayOfWeek
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m DayOfWeek
day_name ParsecT s u m DayOfWeek -> String -> ParsecT s u m DayOfWeek
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"day-of-the-week name"

-- | Parse a 'year' but allow for a two-digit number (obsolete) and the
-- obsolete folding syntax.

obs_year :: Stream s m Char => ParsecT s u m Int
obs_year :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_year = ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (Int -> Int
forall {a}. (Ord a, Num a) => a -> a
normalize (Int -> Int) -> (String -> Int) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Read a => String -> a
read (String -> Int) -> ParsecT s u m String -> ParsecT s u m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a.
Int -> ParsecT s u m a -> ParsecT s u m [a]
manyN Int
2 ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit) ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"year"
 where
  normalize :: a -> a
normalize a
n | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
49   = a
2000 a -> a -> a
forall a. Num a => a -> a -> a
+ a
n
              | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
999  = a
1900 a -> a -> a
forall a. Num a => a -> a -> a
+ a
n
              | Bool
otherwise = a
n

-- | Parse a 'month_name' but allow for the obsolete folding syntax.

obs_month :: Stream s m Char => ParsecT s u m Int
obs_month :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_month = ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
between ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
month_name ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"month name"

-- | Parse a 'day' but allow for the obsolete folding syntax.

obs_day :: Stream s m Char => ParsecT s u m Int
obs_day :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_day = ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
day_of_month ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"day"

-- | Parse a 'hour' but allow for the obsolete folding syntax.

obs_hour :: Stream s m Char => ParsecT s u m Int
obs_hour :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_hour = ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
hour ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"hour"

-- | Parse a 'minute' but allow for the obsolete folding syntax.

obs_minute :: Stream s m Char => ParsecT s u m Int
obs_minute :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_minute = ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
minute ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"minute"

-- | Parse a 'second' but allow for the obsolete folding syntax.

obs_second :: Stream s m Char => ParsecT s u m Int
obs_second :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
obs_second = ParsecT s u m Int -> ParsecT s u m Int
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold ParsecT s u m Int
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Int
second ParsecT s u m Int -> String -> ParsecT s u m Int
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"second"

-- | Match the obsolete zone names and return the appropriate offset.

obs_zone :: Stream s m Char => ParsecT s u m TimeZone
obs_zone :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m TimeZone
obs_zone = [ParsecT s u m TimeZone] -> ParsecT s u m TimeZone
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ String -> Int -> ParsecT s u m TimeZone
parseZone String
"UT"  Int
0
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"GMT" Int
0
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"EST" (-Int
5)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"EDT" (-Int
4)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"CST" (-Int
6)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"CDT" (-Int
5)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"MST" (-Int
7)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"MDT" (-Int
6)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"PST" (-Int
8)
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"PDT" (-Int
7)
                  , do r <- String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'A' .. Char
'I']
                       mkZone (ord r - 64)
                     ParsecT s u m TimeZone -> String -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"military zone spec"
                  , do r <- String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'K' .. Char
'M']
                       mkZone (ord r - 65)
                    ParsecT s u m TimeZone -> String -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"military zone spec"
                  , do r <- String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf [Char
'N' .. Char
'Y']
                       mkZone (-(ord r - 77))
                    ParsecT s u m TimeZone -> String -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"military zone spec"
                  , String -> Int -> ParsecT s u m TimeZone
parseZone String
"Z" Int
0 ParsecT s u m TimeZone -> String -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"military zone spec"
                  ]
 where
  parseZone :: String -> Int -> ParsecT s u m TimeZone
parseZone String
n Int
o = ParsecT s u m TimeZone -> ParsecT s u m TimeZone
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
n ParsecT s u m String
-> ParsecT s u m TimeZone -> ParsecT s u m TimeZone
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT s u m TimeZone
mkZone Int
o)
  mkZone :: Int -> ParsecT s u m TimeZone
mkZone = TimeZone -> ParsecT s u m TimeZone
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeZone -> ParsecT s u m TimeZone)
-> (Int -> TimeZone) -> Int -> ParsecT s u m TimeZone
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TimeZone
hoursToTimeZone

-- * Obsolete Addressing (section 4.4)

-- | This parser matches the \"obsolete angle address\" syntax, a construct
-- that used to be called \"route address\" in earlier RFCs. It differs from a
-- standard 'angle_addr' in two ways: (1) it allows far more liberal insertion
-- of folding whitespace and comments and (2) the address may contain a
-- \"route\" (which this parser ignores):
--
-- >>> parse obs_angle_addr "" "<@example1.org,@example2.org:joe@example.org>"
-- Right "<joe@example.org>"

obs_angle_addr :: Stream s m Char => ParsecT s u m String
obs_angle_addr :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_angle_addr = ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (do _    <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'<'
                            _    <- option [] obs_route
                            addr <- addr_spec
                            _    <- char '>'
                            return ("<" ++ addr ++ ">") -- TODO: route is lost here.
                        )
                 ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"obsolete angle address"

-- | This parser parses the \"route\" part of 'obs_angle_addr' and returns the
-- list of 'String's that make up this route. Relies on 'obs_domain_list' for
-- the actual parsing.

obs_route :: Stream s m Char => ParsecT s u m [String]
obs_route :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_route = ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m a
unfold (ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_domain_list ParsecT s u m [String]
-> ParsecT s u m Char -> ParsecT s u m [String]
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
':') ParsecT s u m [String] -> String -> ParsecT s u m [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"route of an obsolete angle address"

-- | This parser parses a list of domain names, each of them prefaced with an
-- \"at\". Multiple names are separated by a comma. The list of 'domain's is
-- returned - and may be empty.

obs_domain_list :: Stream s m Char => ParsecT s u m [String]
obs_domain_list :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_domain_list = do _  <- Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'@'
                     r1 <- domain
                     r2 <- many $ do _ <- cfws <|> string ","
                                     optional cfws
                                     _ <- char '@'
                                     domain
                     return (r1 : r2)
                  ParsecT s u m [String] -> String -> ParsecT s u m [String]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"route of an obsolete angle address"

-- | Parse the obsolete syntax of a 'local_part', which allowed for more
-- liberal insertion of folding whitespace and comments. The actual string is
-- returned.

obs_local_part :: Stream s m Char => ParsecT s u m String
obs_local_part :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_local_part = do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
word
                    r2 <- many $ do _ <- string "."
                                    r <- word
                                    return ('.' : r)
                    return (r1 ++ concat r2)
                 ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"local part of an address"

-- | Parse the obsolete syntax of a 'domain', which allowed for more liberal
-- insertion of folding whitespace and comments. The actual string is returned.

obs_domain :: Stream s m Char => ParsecT s u m String
obs_domain :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_domain = do r1 <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
atom
                r2 <- many $ do _ <- string "."
                                r <- atom
                                return ('.' : r)
                return (r1 ++ concat r2)
             ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"domain part of an address"

-- | This parser will match the obsolete syntax for a 'mailbox_list'. This one
-- is quite weird: An 'obs_mbox_list' contains an arbitrary number of
-- 'mailbox'es - including none -, which are separated by commas. But you may
-- have multiple consecutive commas without giving a 'mailbox'. You may also
-- have a valid 'obs_mbox_list' that contains /no/ 'mailbox' at all. On the
-- other hand, you /must/ have at least one comma. The following example is
-- valid:
--
-- >>> parse obs_mbox_list "" ","
-- Right []
--
-- But this one is not:
--
-- >>> parse obs_mbox_list "" "joe@example.org"
-- Left (line 1, column 16):
-- unexpected end of input
-- expecting obsolete syntax for a list of mailboxes

obs_mbox_list :: Stream s m Char => ParsecT s u m [NameAddr]
obs_mbox_list :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_mbox_list = do r1 <- ParsecT s u m (Maybe NameAddr) -> ParsecT s u m [Maybe NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m (Maybe NameAddr) -> ParsecT s u m [Maybe NameAddr])
-> ParsecT s u m (Maybe NameAddr) -> ParsecT s u m [Maybe NameAddr]
forall a b. (a -> b) -> a -> b
$ ParsecT s u m (Maybe NameAddr) -> ParsecT s u m (Maybe NameAddr)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m (Maybe NameAddr) -> ParsecT s u m (Maybe NameAddr))
-> ParsecT s u m (Maybe NameAddr) -> ParsecT s u m (Maybe NameAddr)
forall a b. (a -> b) -> a -> b
$ do r <- ParsecT s u m NameAddr -> ParsecT s u m (Maybe NameAddr)
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox
                                          _ <- unfold (char ',')
                                          return r
                   r2 <- maybeOption mailbox
                   return (catMaybes (r1 ++ [r2]))
                ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"obsolete syntax for a list of mailboxes"

-- | This parser is identical to 'obs_mbox_list' but parses a list of
-- 'address'es rather than 'mailbox'es. The main difference is that an
-- 'address' may contain 'group's. Please note that as of now, the parser will
-- return a simple list of addresses; the grouping information is lost.

obs_addr_list :: Stream s m Char => ParsecT s u m [NameAddr]
obs_addr_list :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_addr_list = do r1 <- ParsecT s u m (Maybe [NameAddr])
-> ParsecT s u m [Maybe [NameAddr]]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many1 (ParsecT s u m (Maybe [NameAddr])
 -> ParsecT s u m [Maybe [NameAddr]])
-> ParsecT s u m (Maybe [NameAddr])
-> ParsecT s u m [Maybe [NameAddr]]
forall a b. (a -> b) -> a -> b
$ ParsecT s u m (Maybe [NameAddr])
-> ParsecT s u m (Maybe [NameAddr])
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT s u m (Maybe [NameAddr])
 -> ParsecT s u m (Maybe [NameAddr]))
-> ParsecT s u m (Maybe [NameAddr])
-> ParsecT s u m (Maybe [NameAddr])
forall a b. (a -> b) -> a -> b
$ do r <- ParsecT s u m [NameAddr] -> ParsecT s u m (Maybe [NameAddr])
forall s (m :: * -> *) u a.
Stream s m Char =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
maybeOption ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address
                                          optional cfws
                                          _ <- char ','
                                          optional cfws
                                          return r
                   r2 <- maybeOption address
                   return (concat (catMaybes (r1 ++ [r2])))
                ParsecT s u m [NameAddr] -> String -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"obsolete syntax for a list of addresses"


-- * Obsolete header fields (section 4.5)

obs_fields :: Stream s m Char => ParsecT s u m [Field]
obs_fields :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [Field]
obs_fields = ParsecT s u m Field -> ParsecT s u m [Field]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many (ParsecT s u m Field -> ParsecT s u m [Field])
-> ParsecT s u m Field -> ParsecT s u m [Field]
forall a b. (a -> b) -> a -> b
$ [ParsecT s u m Field] -> ParsecT s u m Field
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice [ ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
From ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_from)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (NameAddr -> Field
Sender (NameAddr -> Field)
-> ParsecT s u m NameAddr -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
obs_sender)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
ReturnPath (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_return)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ReplyTo ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_reply_to)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
To ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_to)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
Cc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_cc)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
Bcc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_bcc)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
MessageID (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_message_id)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([String] -> Field
InReplyTo ([String] -> Field)
-> ParsecT s u m [String] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_in_reply_to)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([String] -> Field
References ([String] -> Field)
-> ParsecT s u m [String] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_references)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
Subject (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_subject)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
Comments (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_comments)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([[String]] -> Field
Keywords ([[String]] -> Field)
-> ([String] -> [[String]]) -> [String] -> Field
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [[String]]
forall a. a -> [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> Field)
-> ParsecT s u m [String] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_keywords)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ZonedTime -> Field
Date (ZonedTime -> Field)
-> ParsecT s u m ZonedTime -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
obs_orig_date)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ZonedTime -> Field
ResentDate (ZonedTime -> Field)
-> ParsecT s u m ZonedTime -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
obs_resent_date)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentFrom ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_from)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (NameAddr -> Field
ResentSender (NameAddr -> Field)
-> ParsecT s u m NameAddr -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
obs_resent_send)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentTo ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_to)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentCc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_cc)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentBcc ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_bcc)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (String -> Field
ResentMessageID (String -> Field) -> ParsecT s u m String -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_resent_mid)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([NameAddr] -> Field
ResentReplyTo ([NameAddr] -> Field)
-> ParsecT s u m [NameAddr] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_reply)
                           , ParsecT s u m Field -> ParsecT s u m Field
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ([(String, String)] -> Field
ObsReceived ([(String, String)] -> Field)
-> ParsecT s u m [(String, String)] -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m [(String, String)]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [(String, String)]
obs_received)
                           , (String -> String -> Field) -> (String, String) -> Field
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Field
OptionalField ((String, String) -> Field)
-> ParsecT s u m (String, String) -> ParsecT s u m Field
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT s u m (String, String)
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
obs_optional    -- catch all
                           ]

-- ** Obsolete origination date field (section 4.5.1)

-- | Parse a 'date' header line but allow for the obsolete folding syntax.

obs_orig_date :: Stream s m Char => ParsecT s u m ZonedTime
obs_orig_date :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
obs_orig_date = String -> ParsecT s u m ZonedTime -> ParsecT s u m ZonedTime
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Date" ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
date_time


-- ** Obsolete originator fields (section 4.5.2)

-- | Parse a 'from' header line but allow for the obsolete folding syntax.

obs_from :: Stream s m Char => ParsecT s u m [NameAddr]
obs_from :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_from = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"From" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list

-- | Parse a 'sender' header line but allow for the obsolete folding syntax.

obs_sender :: Stream s m Char => ParsecT s u m NameAddr
obs_sender :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
obs_sender = String -> ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Sender" ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox

-- | Parse a 'reply_to' header line but allow for the obsolete folding syntax.

obs_reply_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_reply_to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_reply_to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Reply-To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list


-- ** Obsolete destination address fields (section 4.5.3)

-- | Parse a 'to' header line but allow for the obsolete folding syntax.

obs_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a 'cc' header line but allow for the obsolete folding syntax.

obs_cc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_cc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_cc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Cc" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list

-- | Parse a 'bcc' header line but allow for the obsolete folding syntax.

obs_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_bcc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_bcc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
header String
"Bcc" (ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list ParsecT s u m [NameAddr]
-> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m () -> [NameAddr] -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))


-- ** Obsolete identification fields (section 4.5.4)

-- | Parse a 'message_id' header line but allow for the obsolete folding
-- syntax.

obs_message_id :: Stream s m Char => ParsecT s u m String
obs_message_id :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_message_id = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Message-ID" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id

-- | Parse an 'in_reply_to' header line but allow for the obsolete folding and
-- the obsolete phrase syntax.

obs_in_reply_to :: Stream s m Char => ParsecT s u m [String]
obs_in_reply_to :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_in_reply_to = String -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"In-Reply-To" (ParsecT s u m [String] -> ParsecT s u m [String])
-> ParsecT s u m [String] -> ParsecT s u m [String]
forall a b. (a -> b) -> a -> b
$ do r <- ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase ParsecT s u m [String] -> String -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []) ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id )
                                                return (filter (/= []) r)

-- | Parse a 'references' header line but allow for the obsolete folding and
-- the obsolete phrase syntax.

obs_references :: Stream s m Char => ParsecT s u m [String]
obs_references :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_references = String -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"References" (ParsecT s u m [String] -> ParsecT s u m [String])
-> ParsecT s u m [String] -> ParsecT s u m [String]
forall a b. (a -> b) -> a -> b
$ do r <- ParsecT s u m String -> ParsecT s u m [String]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ((ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
phrase ParsecT s u m [String] -> String -> ParsecT s u m String
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []) ParsecT s u m String
-> ParsecT s u m String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id)
                                              return (filter (/= []) r)

-- | Parses the \"left part\" of a message ID, but allows the obsolete syntax,
-- which is identical to a 'local_part'.

obs_id_left :: Stream s m Char => ParsecT s u m String
obs_id_left :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_id_left = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
local_part ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"left part of an message ID"

-- | Parses the \"right part\" of a message ID, but allows the obsolete syntax,
-- which is identical to a 'domain'.

obs_id_right :: Stream s m Char => ParsecT s u m String
obs_id_right :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_id_right = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
domain ParsecT s u m String -> String -> ParsecT s u m String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"right part of an message ID"


-- ** Obsolete informational fields (section 4.5.5)

-- | Parse a 'subject' header line but allow for the obsolete folding syntax.

obs_subject :: Stream s m Char => ParsecT s u m String
obs_subject :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_subject = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Subject" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
unstructured

-- | Parse a 'comments' header line but allow for the obsolete folding syntax.

obs_comments :: Stream s m Char => ParsecT s u m String
obs_comments :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_comments = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Comments" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
unstructured

-- | Parse a 'keywords' header line but allow for the obsolete folding syntax.
-- Also, this parser accepts 'obs_phrase_list'.

obs_keywords :: Stream s m Char => ParsecT s u m [String]
obs_keywords :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_keywords = String -> ParsecT s u m [String] -> ParsecT s u m [String]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Keywords" ParsecT s u m [String]
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m [String]
obs_phrase_list


-- ** Obsolete resent fields (section 4.5.6)

-- | Parse a 'resent_from' header line but allow for the obsolete folding
-- syntax.

obs_resent_from :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_from :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_from = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-From" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list

-- | Parse a 'resent_sender' header line but allow for the obsolete folding
-- syntax.

obs_resent_send :: Stream s m Char => ParsecT s u m NameAddr
obs_resent_send :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
obs_resent_send = String -> ParsecT s u m NameAddr -> ParsecT s u m NameAddr
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-Sender" ParsecT s u m NameAddr
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m NameAddr
mailbox

-- | Parse a 'resent_date' header line but allow for the obsolete folding
-- syntax.

obs_resent_date :: Stream s m Char => ParsecT s u m ZonedTime
obs_resent_date :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
obs_resent_date = String -> ParsecT s u m ZonedTime -> ParsecT s u m ZonedTime
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-Date" ParsecT s u m ZonedTime
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m ZonedTime
date_time

-- | Parse a 'resent_to' header line but allow for the obsolete folding syntax.

obs_resent_to :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_to :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_to = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list

-- | Parse a 'resent_cc' header line but allow for the obsolete folding syntax.

obs_resent_cc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_cc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_cc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-Cc" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
mailbox_list

-- | Parse a 'resent_bcc' header line but allow for the obsolete folding
-- syntax.

obs_resent_bcc :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_bcc :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_bcc = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Bcc" (ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list ParsecT s u m [NameAddr]
-> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT s u m String -> ParsecT s u m ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
cfws ParsecT s u m () -> [NameAddr] -> ParsecT s u m [NameAddr]
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []))

-- | Parse a 'resent_msg_id' header line but allow for the obsolete folding
-- syntax.

obs_resent_mid :: Stream s m Char => ParsecT s u m String
obs_resent_mid :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_resent_mid = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-Message-ID" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
msg_id

-- | Parse a @Resent-Reply-To@ header line but allow for the obsolete folding
-- syntax.

obs_resent_reply :: Stream s m Char => ParsecT s u m [NameAddr]
obs_resent_reply :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
obs_resent_reply = String -> ParsecT s u m [NameAddr] -> ParsecT s u m [NameAddr]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Resent-Reply-To" ParsecT s u m [NameAddr]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [NameAddr]
address_list


-- ** Obsolete trace fields (section 4.5.7)

obs_return :: Stream s m Char => ParsecT s u m String
obs_return :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_return = String -> ParsecT s u m String -> ParsecT s u m String
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Return-Path" ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
path

obs_received :: Stream s m Char => ParsecT s u m [(String, String)]
obs_received :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [(String, String)]
obs_received = String
-> ParsecT s u m [(String, String)]
-> ParsecT s u m [(String, String)]
forall s (m :: * -> *) u a.
Stream s m Char =>
String -> ParsecT s u m a -> ParsecT s u m a
obs_header String
"Received" ParsecT s u m [(String, String)]
forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m [(String, String)]
name_val_list

-- | Match 'obs_angle_addr'.

obs_path :: Stream s m Char => ParsecT s u m String
obs_path :: forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_path = ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
obs_angle_addr

-- | This parser is identical to 'optional_field' but allows the more liberal
-- line-folding syntax between the \"field_name\" and the \"field text\".

obs_optional :: Stream s m Char => ParsecT s u m (String, String)
obs_optional :: forall s (m :: * -> *) u.
Stream s m Char =>
ParsecT s u m (String, String)
obs_optional = do n <- ParsecT s u m String
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m String
field_name
                  _ <- many wsp
                  _ <- char ':'
                  b <- unstructured
                  _ <- crlf
                  return (n, b)
               ParsecT s u m (String, String)
-> String -> ParsecT s u m (String, String)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"optional (unspecified) header line"