render non-text parts

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