test5: allow attaching files (creates new message)

1 files changed, 18 insertions, 1 deletions

diff --git a/Notmuch.hs b/Notmuch.hs
index eb839fd..e6d0d32 100644
--- a/Notmuch.hs
+++ b/Notmuch.hs
@@ -1,9 +1,12 @@
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 module Notmuch where
 
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString.Lazy.Char8 as LBS8
+import qualified Data.Text.Lazy as LT
+import qualified Data.Text.Lazy.Encoding as LT
+import qualified Network.Mail.Mime as M
 import Control.Concurrent
 import Control.DeepSeq (rnf)
 import Control.Exception
@@ -13,6 +16,7 @@ import Data.Tree
 import Notmuch.Class
 import Notmuch.Message
 import Notmuch.SearchResult
+import ParseMail (readMail)
 import System.Exit
 import System.IO
 import System.Process
@@ -179,6 +183,19 @@ notmuchShowPart term partId = do
         _ -> Left $ show exitCode <> ": " <> LBS8.unpack err
 
 
+notmuchShowMail :: String -> IO (Either String M.Mail)
+notmuchShowMail term =
+    notmuch' [ "show", "--format=raw", "--format-version=2", term ]
+    >>= return . \case
+      (ExitSuccess, out, _) ->
+          case LT.decodeUtf8' out of
+              Right x -> Right (readMail $ LT.toStrict x)
+              Left ex -> Left $ "meh" ++ show ex
+      (exitCode, _, err) ->
+          Left $ "notmuch failed with exit code " ++ show exitCode ++
+                 ": " ++ LBS8.unpack err
+
+
 notmuchTag :: HasNotmuchId a => [TagOp] -> a -> IO ()
 notmuchTag tagOps x =
     notmuch ("tag" : tagOpsToArgs tagOps ++ [notmuchId x]) >> return ()