51 lines
1.2 KiB
Haskell
51 lines
1.2 KiB
Haskell
module Data.Email.Header where
|
|
|
|
import Data.Text
|
|
(Text)
|
|
import qualified Data.Text as T
|
|
|
|
import qualified Data.Foldable as F
|
|
|
|
import Data.Attoparsec.Text
|
|
|
|
import Data.Vector
|
|
(Vector)
|
|
import qualified Data.Vector as V
|
|
|
|
import Data.Char
|
|
(isSpace)
|
|
|
|
import Control.Applicative
|
|
((<|>))
|
|
|
|
data Header
|
|
= From !Text
|
|
| To !(Vector Text)
|
|
deriving (Show, Eq)
|
|
|
|
decode :: Text -> Either String Header
|
|
decode = parseOnly parseHeader
|
|
where
|
|
parseHeader :: Parser Header
|
|
parseHeader = parseFrom <|> parseTo
|
|
parseFrom :: Parser Header
|
|
parseFrom = From <$> (string "From:" *> emptySpace *> email)
|
|
parseTo :: Parser Header
|
|
parseTo = To <$> (string "To:" *> emptySpace *> emails)
|
|
emptySpace = many' space
|
|
emails :: Parser (Vector Text)
|
|
emails = V.fromList <$> email `sepBy` char ','
|
|
email :: Parser Text
|
|
email = do
|
|
_ <- many' space
|
|
name <- T.pack <$> many' (notChar '@')
|
|
_ <- char '@'
|
|
rest <- T.pack <$> many' (satisfy (\c -> not (isSpace c) && c /= ','))
|
|
pure (name <> "@" <> rest)
|
|
|
|
|
|
encode :: Header -> Text
|
|
encode = \case
|
|
From addr -> "From: " <> addr
|
|
To addrs -> "To: " <> T.intercalate ", " (F.toList addrs)
|