From 7b9f243320cfe33ddb4f89be81483dd775cc49b0 Mon Sep 17 00:00:00 2001 From: tv Date: Thu, 5 Mar 2015 15:39:13 +0100 Subject: test5: allow attaching files (creates new message) --- Notmuch.hs | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'Notmuch.hs') 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 () -- cgit v1.2.3