diff options
| -rw-r--r-- | Notmuch.hs | 13 | ||||
| -rw-r--r-- | ThreadView.hs | 56 | ||||
| -rw-r--r-- | env.nix | 1 | ||||
| -rw-r--r-- | test3.hs | 25 |
4 files changed, 72 insertions, 23 deletions
@@ -89,15 +89,14 @@ notmuch args = do -- BS.hGetContents hout -search :: String -> IO () -search term = do - c <- notmuch [ "search", "--format=json", "--format-version=2", term ] +search :: String -> IO (Either String [SearchResult]) +search term = + notmuch [ "search", "--format=json", "--format-version=2", term ] + >>= return . eitherDecode' - let results = case eitherDecode' c :: Either String [SearchResult] of - Left err -> error err - Right x -> x - mapM_ (T.putStrLn . drawSearchResult) results +putSearchResults :: [SearchResult] -> IO () +putSearchResults = mapM_ (T.putStrLn . drawSearchResult) showThread :: String -> IO () diff --git a/ThreadView.hs b/ThreadView.hs index d9bf4a1..1c908bb 100644 --- a/ThreadView.hs +++ b/ThreadView.hs @@ -29,9 +29,8 @@ import qualified Data.Text as T --import System.IO --import qualified Data.Map as M ---import Notmuch.SearchResult import Notmuch.Message ---import Notmuch +import Notmuch.SearchResult import Safe @@ -42,6 +41,8 @@ data ThreadView = TVMessage Message | TVMessagePart Message MessagePart | TVMessageLine Message MessagePart LineNr String + | TVSearch String + | TVSearchResult SearchResult deriving (Show) instance Eq ThreadView where @@ -54,13 +55,21 @@ instance Eq ThreadView where TVMessageLine m1 mp1 ln1 _s1 == TVMessageLine m2 mp2 ln2 _s2 = m1 == m2 && mp1 == mp2 && ln1 == ln2 + TVSearch s1 == TVSearch s2 = + s1 == s2 + + TVSearchResult s1 == TVSearchResult s2 = + s1 == s2 + _ == _ = False describe :: ThreadView -> String -describe (TVMessage m) = "TVMessage" <> unMessageID (messageId m) +describe (TVMessage m) = "TVMessage " <> unMessageID (messageId m) describe (TVMessagePart m p) = "TVMessagePart " <> (unMessageID $ messageId m) <> " " <> show (partID p) describe (TVMessageLine _ _ _ s) = "TVMessageLine " <> show s +describe (TVSearch s) = "TVSearch " <> show s +describe (TVSearchResult sr) = "TVSearchResult " <> show (searchTotal sr) focusPrev :: Tree ThreadView -> Maybe ThreadView -> Maybe ThreadView @@ -92,6 +101,11 @@ findTV x = find (==x) . flatten +fromSearchResults :: String -> [SearchResult] -> Tree ThreadView +fromSearchResults query = + Node (TVSearch query) . map (\r -> Node (TVSearchResult r) []) + + fromMessageTree :: Tree Message -> Tree ThreadView fromMessageTree (Node m ms) = Node m' ms' @@ -157,6 +171,27 @@ threadViewImage hasFocus = \case TVMessageLine _ _ _ s -> string ml s + TVSearch s -> + string sColor s + + TVSearchResult sr -> do + let ThreadID tid = searchThread sr + --string srColor tid + -- <|> + --translateX 1 + (string srColor $ padl 11 ' ' $ T.unpack $ searchDateRel sr) + <|> + string srColor " (" + <|> + (string srColor $ show $ searchMatched sr) + <|> + string srColor ")" + <|> + string srColor " " + -- <|> + -- (string srColor $ show $ searchTime sr) + <|> + (string srColor $ T.unpack $ searchSubject sr) where --c1 = if hasFocus then c1_focus else c1_nofocus --c1_nofocus = withForeColor def $ Color240 $ -16 + 238 @@ -188,4 +223,19 @@ threadViewImage hasFocus = \case mp_y = withForeColor def $ color 199 mp_n = withForeColor def $ color 162 + sColor = if hasFocus then sColor_y else sColor_n + sColor_y = withForeColor def $ color 196 + sColor_n = withForeColor def $ color 88 + + srColor = if hasFocus then srColor_y else srColor_n + srColor_y = withForeColor def $ color 197 + srColor_n = withForeColor def $ color 89 + color i = Color240 $ -16 + i + + + +padl n c s = + if length s < n + then padl n c (c:s) + else s @@ -29,6 +29,7 @@ let #conduit #conduitExtra process + rosezipper safe ] ); @@ -18,6 +18,7 @@ import Graphics.Vty --import Data.String --import Data.Traversable import Data.Tree +import qualified Data.Tree.Zipper as Z --import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS --import qualified Data.ByteString.Char8 as BS8 @@ -30,15 +31,16 @@ import qualified Data.Text as T --import System.IO --import qualified Data.Map as M ---import Notmuch.SearchResult +import Notmuch import Notmuch.Message -import Notmuch -- hiding (focusPrev, focusNext) +import Notmuch.SearchResult --import Safe import Control.Exception import ThreadView +import TreeSearch @@ -67,18 +69,15 @@ import ThreadView -- msgs = flatten t -toggleTag :: T.Text -> ThreadView -> IO () -toggleTag tag = \case - TVMessage m -> f m - _ -> return () +toggleTag :: T.Text -> Message -> IO () +toggleTag tag m = do + _ <- if tag `elem` messageTags m + then + unsetTag tagString (unMessageID $ messageId m) + else + setTag tagString (unMessageID $ messageId m) + return () where - f m = do - _ <- if tag `elem` messageTags m - then - unsetTag tagString (unMessageID $ messageId m) - else - setTag tagString (unMessageID $ messageId m) - return () tagString = T.unpack tag |