summaryrefslogtreecommitdiffstats
path: root/test3.hs
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2014-12-27 22:50:28 +0100
committertv <tv@shackspace.de>2014-12-27 22:50:28 +0100
commit64866fd52521935d775471af8587dd32ed109fb9 (patch)
treec5b9fcc3e900941e2fa21f4fde31b27d467c624f /test3.hs
parentdf135474c2d4934515890aeb57d1e400f0bc488f (diff)
test3: emergency commit
Diffstat (limited to 'test3.hs')
-rw-r--r--test3.hs144
1 files changed, 137 insertions, 7 deletions
diff --git a/test3.hs b/test3.hs
index a7dc661..16bbe61 100644
--- a/test3.hs
+++ b/test3.hs
@@ -9,12 +9,13 @@ import Graphics.Vty
--import Data.List
+import Control.Applicative
--import Language.Haskell.TH.Ppr (bytesToString)
--import Data.Aeson
--import Data.List.Split
--import Data.Attoparsec.ByteString hiding (string)
import Data.Maybe
---import Data.Monoid
+import Data.Monoid
--import Data.String
--import Data.Traversable
import Data.Tree
@@ -31,6 +32,7 @@ import qualified Data.Text as T
--import System.IO
--import qualified Data.Map as M
+import System.Environment
import Notmuch
import Notmuch.Message
import Notmuch.SearchResult
@@ -41,6 +43,16 @@ import Control.Exception
import TreeView
import TreeSearch
+--import Editor (edit)
+import System.Process
+import System.Environment
+import qualified Data.ByteString.Lazy as LBS
+import System.IO
+import System.Directory
+import Control.Exception (bracket)
+import Control.Exception
+import System.IO
+import Control.DeepSeq (rnf)
data State = State
@@ -79,7 +91,8 @@ main =
main' "tag:inbox AND NOT tag:killed"
main' :: String -> IO ()
-main' query =
+main' query = do
+ setEnv "HOME" "/home/tv"
bracket (mkVty def) finit run
where
@@ -93,7 +106,7 @@ main' query =
--let c = findMessage (MessageID "87egtmvj0n.fsf@write-only.cryp.to") v
--rec vty 0 c v
- Right r_ <- search query
+ r_ <- either error id <$> search query
rec State
{ vty = vty0
, cursor = Z.fromTree $ fromSearchResults query r_
@@ -134,10 +147,20 @@ main' query =
EvKey KEnter [] ->
onEnter cursor
- EvKey (KChar 'H') [] -> rec q { xoffset = xoffset - 1 }
- EvKey (KChar 'L') [] -> rec q { xoffset = xoffset + 1 }
- EvKey (KChar 'J') [] -> rec q { yoffset = yoffset - 1 }
- EvKey (KChar 'K') [] -> rec q { yoffset = yoffset + 1 }
+ EvKey (KChar 'H') [] -> rec q { xoffset = xoffset - 3 }
+ EvKey (KChar 'L') [] -> rec q { xoffset = xoffset + 3 }
+ EvKey (KChar 'J') [] -> rec q { yoffset = yoffset - 3 }
+ EvKey (KChar 'K') [] -> rec q { yoffset = yoffset + 3 }
+
+ EvKey (KChar 'r') [] ->
+ case getMessage (Z.label cursor) of
+ Just m -> do
+ replyToAll m q >>= rec
+ Nothing ->
+ rec q { message = "no message" }
+ --reply ToAll q >>= \case
+ -- Left s -> rec q { message = s }
+ -- Right () -> rec q
EvResize _w _h ->
rec q
@@ -191,3 +214,110 @@ treeImage :: Maybe TreeView -> Tree TreeView -> Image
treeImage c (Node n ns) =
treeViewImage (c == Just n) n <->
translateX 2 (vertCat $ map (treeImage c) ns)
+
+
+--reply :: ReplyTo -> State -> IO (Either String ())
+--reply replyTo _q@State{..} =
+-- case getMessage (Z.label cursor) of
+-- Just Message{..} -> do
+-- x <- notmuchReply replyTo ("id:" <> unMessageID messageId)
+-- edit x
+-- return $ Right ()
+-- Nothing ->
+-- return $ Left "no message"
+
+--edit :: LBS.ByteString -> IO ()
+--edit draft = do
+-- editor <- getEnv "EDITOR"
+-- logname <- getEnv "LOGNAME"
+-- tmpdir <- getTemporaryDirectory
+--
+-- let template = logname ++ "_much_draft_XXX.email"
+--
+-- bracket (openTempFile tmpdir template) cleanup $ \(path, h) -> do
+-- LBS.hPut h draft
+-- hClose h
+-- --hFlush h
+-- system (editor ++ " " ++ path)
+-- return ()
+-- where
+-- cleanup (path, h) = do
+-- removeFile path
+-- hClose h
+
+replyToAll Message{..} q = do
+ editor <- getEnv "EDITOR"
+ logname <- getEnv "LOGNAME"
+ tmpdir <- getTemporaryDirectory
+
+ let template = logname ++ "_much_draft_XXX.email"
+
+ bracket (openTempFile tmpdir template) cleanup $ \(path, draftH) -> do
+ (_, _, _, procH) <-
+ withFile "/dev/null" ReadMode $ \devnull ->
+ createProcess
+ (proc "notmuch" [ "reply" , "id:" <> unMessageID messageId ])
+ { std_in = UseHandle devnull
+ , std_out = UseHandle draftH
+ }
+ hClose draftH
+ waitForProcess procH
+ code <- system (editor ++ " " ++ path)
+ return q { message = show code }
+ where
+ cleanup = removeFile . fst
+
+
+replyToAll2 = do
+ editor <- getEnv "EDITOR"
+ logname <- getEnv "LOGNAME"
+ tmpdir <- getTemporaryDirectory
+
+ let template = logname ++ "_much_draft_XXX.email"
+
+ let msgId = "20141227121335.701B43F@mx2.informatik.uni-stuttgart.de"
+
+ bracket (openTempFile tmpdir template) cleanup $ \(path, draftH) -> do
+ (_, _, _, procH) <-
+ withFile "/dev/null" ReadMode $ \devnull ->
+ createProcess
+ (proc "notmuch" [ "reply" , "id:" <> msgId ])
+ { std_in = UseHandle devnull
+ , std_out = UseHandle draftH
+ }
+ hClose draftH
+ waitForProcess procH
+ code <- system (editor ++ " " ++ path)
+ print code
+ --return q { message = show code }
+ where
+ cleanup = removeFile . fst
+
+
+
+-- (_, Just hout, _, ph) <- createProcess (proc "notmuch" args)
+-- { std_out = CreatePipe }
+-- output <- LBS.hGetContents hout
+--
+--
+-- withForkWait (evaluate $ rnf output) $ \waitOut -> do
+--
+-- ---- now write any input
+-- --unless (null input) $
+-- -- ignoreSigPipe $ hPutStr inh input
+-- -- hClose performs implicit hFlush, and thus may trigger a SIGPIPE
+-- --ignoreSigPipe $ hClose inh
+--
+-- -- wait on the output
+-- waitOut
+-- hClose hout
+--
+-- -- wait on the process
+-- _ex <- waitForProcess ph
+-- --return (ex, output)
+--
+-- --case ex of
+-- -- ExitSuccess -> return output
+-- -- ExitFailure r -> processFailedException "readProcess" cmd args r
+--
+-- return output