summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@shackspace.de>2015-03-08 22:31:16 +0100
committertv <tv@shackspace.de>2015-03-08 22:31:16 +0100
commitbce97ef3a0ee9f3ebaea0056b488009b73772fd7 (patch)
treec8867e53390f3cd93bce2a984ff05f6bdf6505fe
parent760a8f544f709f0e7648704a77f13c2ea2a6d279 (diff)
test5: ditch runEditor'
-rw-r--r--test5.hs79
1 files changed, 43 insertions, 36 deletions
diff --git a/test5.hs b/test5.hs
index 5ee6ea8..723527b 100644
--- a/test5.hs
+++ b/test5.hs
@@ -23,6 +23,7 @@ import Control.Exception
import Control.Monad
import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except
+import Data.Aeson (eitherDecode')
import Data.Foldable (foldrM)
import Data.List (intercalate)
import Data.Maybe
@@ -39,7 +40,6 @@ 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
import TagUtils
@@ -317,16 +317,7 @@ keymap "=" = \q@State{..} ->
hyp = Just german_1996
bf = BreakFormat 80 8 shy hyp
-keymap "\ESCq" = \q@State{..} ->
- let parse = filter (/='\n') -- TODO proper parse
- draft = fromMaybe "" $ getSearchTerm $ Z.label $ Z.root cursor
- in editString q draft >>= \case
- Left err -> return q { flashMessage = Plain err }
- Right s' -> Notmuch.search s' >>= \case
- Left err ->
- return q { flashMessage = Plain err }
- Right result ->
- return q { cursor = Z.fromTree $ fromSearchResults (parse s') result }
+keymap "\ESCq" = editSearchTerm
-- <F1>
keymap "\ESC[11~" = \q@State{..} ->
@@ -636,6 +627,13 @@ editMailE ps =
Left code -> throwE $ "edit mail error: " ++ show code
+editStringE :: String -> ExceptT String IO String
+editStringE s =
+ liftE (editString s) >>= \case
+ Right r -> return r
+ Left code -> throwE $ "edit string error: " ++ show code
+
+
editTagsE :: [Tag] -> ExceptT String IO [TagOp]
editTagsE ps =
liftE (editTags ps) >>= \case
@@ -737,6 +735,29 @@ viewSource q0 =
liftE (readFile $ Notmuch.messageFilename msg) >>= viewMailE
+editSearchTerm :: State -> IO State
+editSearchTerm q0 =
+ runExceptT (go q0) >>= return . \case
+ Right q' -> q'
+ Left err -> q0 { flashMessage = Plain $ "error: " ++ show err }
+ where
+ go :: State -> ExceptT String IO State
+ go q@State{..} = do
+
+ let parse = filter (/='\n') -- TODO proper parse
+ s = fromMaybe "" $ getSearchTerm $ Z.label $ Z.root cursor
+
+ s' <- editStringE s
+
+ result <-
+ either throwE return . eitherDecode' . fst =<<
+ readNotmuchE ["search", "--format=json", "--format-version=2", s'] ""
+ -- ^ TODO duplicates Notmuch.search
+
+ return q { cursor = Z.fromTree $ fromSearchResults (parse s') result }
+
+
+
editTagsAtCursor :: State -> IO State
editTagsAtCursor q0 =
runExceptT (go q0) >>= return . \case
@@ -800,31 +821,6 @@ select p loc =
in fromMaybe root $ findTree p root
-editString :: State -> String -> IO (Either String String)
-editString q s =
- withTempFile' ".string" $ \(path, h) -> do
- hPutStr stdout "\ESC[?1049h" -- TODO geht besser
- hPutStr stdout "\ESC[?25l" -- TODO war mal besser
- setFileMode path 0o600
-
- hPutStr h s
-
- hClose h
-
- runEditor' path q >>= \case
- ExitFailure code ->
- return . Left $ "error exit code = " <> show code
- ExitSuccess ->
- Right <$> readFile path
-
-
-
-runEditor' :: [Char] -> State -> IO ExitCode
-runEditor' path q@State{..} = do
- editor <- getEnv "EDITOR"
- system (editor ++ " " ++ path) <* resetTerm q
-
-
withTempFile' :: FilePath -> ((FilePath, Handle) -> IO a) -> IO a
withTempFile' s f = do
logname <- getEnv "LOGNAME"
@@ -863,6 +859,17 @@ editMail s =
code -> return (Left code)
+editString :: String -> IO (Either ExitCode String)
+editString s =
+ withTempFile' "edit.string" $ \(path, h_tempFile) -> do
+ hPutStr h_tempFile s
+ hClose h_tempFile
+ editor <- getEnv "EDITOR"
+ runInteractive editor [path] >>= \case
+ ExitSuccess -> Right <$> readFile path
+ code -> return (Left code)
+
+
editTags :: [Tag] -> IO (Either ExitCode [TagOp])
editTags tags =
withTempFile' "edit.tags" $ \(path, h_tempFile) -> do