Initial email header parsing

src/Data/Email/Header.hs

@@ -0,0 +1,50 @@
+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)