diff options
Diffstat (limited to 'src/Notmuch')
| -rw-r--r-- | src/Notmuch/Message.hs | 26 |
1 files changed, 20 insertions, 6 deletions
diff --git a/src/Notmuch/Message.hs b/src/Notmuch/Message.hs index d08be39..681b5db 100644 --- a/src/Notmuch/Message.hs +++ b/src/Notmuch/Message.hs @@ -9,6 +9,7 @@ import Data.Time.Calendar import Data.Time.Clock import Data.Time.Clock.POSIX import Notmuch.Class +import qualified Data.ByteString.Lazy.Char8 as LBS8 import qualified Data.Text as T import qualified Data.Map as M import qualified Data.CaseInsensitive as CI @@ -23,6 +24,7 @@ newtype MessageID = MessageID { unMessageID :: String } type MessageHeaders = M.Map (CI.CI T.Text) T.Text data MessageContent = ContentText T.Text + | ContentRaw LBS8.ByteString Int | ContentMultipart [MessagePart] | ContentMsgRFC822 [(MessageHeaders, [MessagePart])] deriving (Show) @@ -44,6 +46,7 @@ contentSize :: MessageContent -> Int contentSize (ContentText text) = T.length text contentSize (ContentMultipart parts) = sum $ map (contentSize . partContent) parts contentSize (ContentMsgRFC822 xs) = sum $ map (sum . map (contentSize . partContent) . snd) xs +contentSize (ContentRaw _ contentLength) = contentLength parseRFC822 :: V.Vector Value -> Parser MessageContent @@ -61,13 +64,24 @@ instance FromJSON MessagePart where x <- v .:? "content" f <- v .:? "filename" cs <- fmap CI.mk <$> v .:? "content-charset" + maybeContentLength <- v .:? "content-length" let ctype = CI.map (T.takeWhile (/= '/')) t - case (ctype, x) of - ("multipart", Just (Array _)) -> MessagePart i t cs f . ContentMultipart <$> v .: "content" - ("message", Just (Array lst)) | t == "message/rfc822" -> MessagePart i t cs f <$> parseRFC822 lst - (_, Just (String c)) -> return $ MessagePart i t cs f $ ContentText c - (_, Just _) -> return $ MessagePart i t cs f $ ContentText $ "Unknown content-type: " <> CI.original t - (_, Nothing) -> return $ MessagePart i t cs f $ ContentText "" + case (ctype, x, maybeContentLength) of + ("multipart", Just (Array _), _) -> + MessagePart i t cs f . ContentMultipart <$> v .: "content" + + ("message", Just (Array lst), _) | t == "message/rfc822" -> + MessagePart i t cs f <$> parseRFC822 lst + + (_, Just (String c), _) -> + return $ MessagePart i t cs f $ ContentText c + + (_, Nothing, Just contentLength) -> + return $ MessagePart i t cs f $ ContentRaw "" contentLength + + (_, _, _) -> + return $ MessagePart i t cs f $ ContentText ("Unknown content-type: " <> CI.original t) + parseJSON x = fail $ "Error parsing part: " ++ show x |