{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Email.Header.Render
(
RenderOptions(..)
, Encoding(..)
, defaultRenderOptions
, Doc
, renderHeaders
, date
, from
, sender
, replyTo
, to
, cc
, bcc
, messageID
, inReplyTo
, references
, subject
, comments
, keywords
, resentDate
, resentFrom
, resentSender
, resentTo
, resentCc
, resentBcc
, resentMessageID
, mimeVersion
, contentType
, contentTransferEncoding
, contentID
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy.Builder as B
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
#if MIN_VERSION_base(4,8,0)
#else
import Data.Monoid
#endif
import qualified Data.Text.Lazy as L
import Data.Time.LocalTime
import Network.Email.Header.Doc
import qualified Network.Email.Header.Pretty as P
import Network.Email.Header.Types
renderHeaders :: RenderOptions -> [(HeaderName, Doc)] -> Headers
renderHeaders r = map (renderHeader r)
renderHeader :: RenderOptions -> (HeaderName, Doc) -> Header
renderHeader r (k, b) = (k, B.toLazyByteString l)
where
l = render r (B.length (CI.original k) + 2) b
buildField :: HeaderName -> (a -> Doc) -> a -> (HeaderName, Doc)
buildField k f a = (k, f a)
date :: ZonedTime -> (HeaderName, Doc)
date = buildField "Date" P.dateTime
from :: [Mailbox] -> (HeaderName, Doc)
from = buildField "From" P.mailboxList
sender :: Mailbox -> (HeaderName, Doc)
sender = buildField "Sender" P.mailbox
replyTo :: [Recipient] -> (HeaderName, Doc)
replyTo = buildField "Reply-To" P.recipientList
to :: [Recipient] -> (HeaderName, Doc)
to = buildField "To" P.recipientList
cc :: [Recipient] -> (HeaderName, Doc)
cc = buildField "Cc" P.recipientList
bcc :: Maybe [Recipient] -> (HeaderName, Doc)
bcc = buildField "Bcc" (maybe mempty P.recipientList)
messageID :: MessageID -> (HeaderName, Doc)
messageID = buildField "Message-ID" P.messageID
inReplyTo :: [MessageID] -> (HeaderName, Doc)
inReplyTo = buildField "In-Reply-To" (sep . map P.messageID)
references :: [MessageID] -> (HeaderName, Doc)
references = buildField "References" (sep . map P.messageID)
subject :: L.Text -> (HeaderName, Doc)
subject = buildField "Subject" P.unstructured
comments :: L.Text -> (HeaderName, Doc)
comments = buildField "Comments" P.unstructured
keywords :: [L.Text] -> (HeaderName, Doc)
keywords = buildField "Keywords" P.phraseList
resentDate :: ZonedTime -> (HeaderName, Doc)
resentDate = buildField "Resent-Date" P.dateTime
resentFrom :: [Mailbox] -> (HeaderName, Doc)
resentFrom = buildField "Resent-From" P.mailboxList
resentSender :: Mailbox -> (HeaderName, Doc)
resentSender = buildField "Resent-Sender" P.mailbox
resentTo :: [Recipient] -> (HeaderName, Doc)
resentTo = buildField "Resent-To" P.recipientList
resentCc :: [Recipient] -> (HeaderName, Doc)
resentCc = buildField "Resent-Cc" P.recipientList
resentBcc :: Maybe [Recipient] -> (HeaderName, Doc)
resentBcc = buildField "Resent-Bcc" (maybe mempty P.recipientList)
resentMessageID :: MessageID -> (HeaderName, Doc)
resentMessageID = buildField "Resent-Message-ID" P.messageID
mimeVersion :: Int -> Int -> (HeaderName, Doc)
mimeVersion major minor = ("MIME-Version", P.mimeVersion major minor)
contentType :: MimeType -> Parameters -> (HeaderName, Doc)
contentType t params = ("Content-Type", P.contentType t params)
contentTransferEncoding :: CI B.ByteString -> (HeaderName, Doc)
contentTransferEncoding =
buildField "Content-Transfer-Encoding" P.contentTransferEncoding
contentID :: MessageID -> (HeaderName, Doc)
contentID = buildField "Content-ID" P.messageID