64 lines
1.5 KiB
Haskell
64 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE ApplicativeDo #-}
|
|
module Data.Email.Header where
|
|
|
|
import qualified Data.Foldable as F
|
|
|
|
import Data.Attoparsec.ByteString.Char8
|
|
|
|
import Data.Vector
|
|
(Vector)
|
|
import qualified Data.Vector as V
|
|
|
|
import Control.Applicative
|
|
((<|>))
|
|
import Data.ByteString (ByteString)
|
|
import qualified Data.ByteString.Char8 as BC
|
|
|
|
data Header
|
|
= From !ByteString
|
|
| To !(Vector ByteString)
|
|
deriving (Show, Eq)
|
|
|
|
decode :: ByteString -> Either String Header
|
|
decode = parseOnly parseHeader
|
|
{-# INLINE decode #-}
|
|
|
|
parseHeader :: Parser Header
|
|
parseHeader = parseFrom <|> parseTo
|
|
{-# INLINE parseHeader #-}
|
|
|
|
parseFrom :: Parser Header
|
|
parseFrom = From <$> (string "From:" *> emptySpace *> (bracketEmail <|> email))
|
|
|
|
parseTo :: Parser Header
|
|
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
|
|
|
emptySpace :: Parser ()
|
|
emptySpace = () <$ many' space
|
|
|
|
emails :: Parser (Vector ByteString)
|
|
emails = V.fromList <$> (bracketEmail <|> email) `sepBy` char ','
|
|
|
|
bracketEmail :: Parser ByteString
|
|
bracketEmail = do
|
|
_ <- manyTill anyChar (char '<')
|
|
email
|
|
{-# INLINE bracketEmail #-}
|
|
|
|
email :: Parser ByteString
|
|
email = do
|
|
_ <- many' space
|
|
name <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= '@'))
|
|
_ <- char '@'
|
|
rest <- BC.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ',' && c /= '>' && c /= '<'))
|
|
_ <- many' (notChar ',')
|
|
pure (name <> "@" <> rest)
|
|
{-# INLINE email #-}
|
|
|
|
|
|
encode :: Header -> ByteString
|
|
encode = \case
|
|
From addr -> "From: " <> addr
|
|
To addrs -> "To: " <> BC.intercalate ", " (F.toList addrs)
|