From 04929712f248dbbdf200693c0751dc925fb03c61 Mon Sep 17 00:00:00 2001 From: tv Date: Sun, 1 Mar 2015 12:06:04 +0100 Subject: test5: add date header --- test5.hs | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) (limited to 'test5.hs') diff --git a/test5.hs b/test5.hs index 76e8ec6..1709be5 100644 --- a/test5.hs +++ b/test5.hs @@ -9,6 +9,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as T import qualified Data.Tree as Tree import qualified Data.Tree.Zipper as Z +import qualified Network.Mail.Mime as M import qualified Notmuch import qualified Notmuch.Message as Notmuch import qualified Notmuch.SearchResult as Notmuch @@ -22,6 +23,7 @@ import Data.Maybe import Data.Monoid import Data.Time import Event +import ParseMail (readMail) import RenderTreeView (renderTreeView) import Scanner (scan) import System.Directory @@ -29,6 +31,7 @@ import System.Console.Docopt (getArgWithDefault, optionsWithUsage, shortOption) import System.Environment import System.Exit import System.IO +import System.Locale (defaultTimeLocale, rfc822DateFormat) import System.Posix.Files import System.Posix.Signals import System.Process @@ -493,7 +496,13 @@ replyToAll q@State{..} = case getMessage (Z.label cursor) of ExitFailure code -> return q { flashMessage = Plain $ "editor exit code = " ++ show code } ExitSuccess -> do - x <- LBS.readFile path + -- TODO check if path has been written to, + -- else abort + draft <- + M.renderMail' =<< + addDateHeader =<< + return . readMail =<< + T.readFile path -- TODO use TagOps Notmuch.notmuchWithInput [ "insert" @@ -503,8 +512,7 @@ replyToAll q@State{..} = case getMessage (Z.label cursor) of , "-inbox" , "-unread" ] - -- TODO rename to draftPath - x >>= \case + draft >>= \case (ExitFailure code, _, _) -> return q { flashMessage = Plain $ "notmuch insert exit code = " ++ show code @@ -660,3 +668,17 @@ withTempFile' s f = do logname <- getEnv "LOGNAME" tmpdir <- getTemporaryDirectory withTempFile tmpdir (logname ++ "_much_" ++ s) f + + +addDateHeader m@M.Mail{..} = do + t <- getCurrentTime + return m + { M.mailHeaders = + ( "Date" + , T.pack $ + formatTime defaultTimeLocale + rfc822DateFormat + t + ) : + mailHeaders + } -- cgit v1.2.3