summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--TreeViewRaw.hs7
-rw-r--r--test5.hs35
2 files changed, 25 insertions, 17 deletions
diff --git a/TreeViewRaw.hs b/TreeViewRaw.hs
index b10f3e6..52ea966 100644
--- a/TreeViewRaw.hs
+++ b/TreeViewRaw.hs
@@ -14,6 +14,7 @@ import Data.Monoid
import Data.Time
import Data.Time.Format.Human
import Data.Tree
+import TagUtils (Tag)
import Trammel
import TreeView
@@ -124,9 +125,9 @@ renderFrom = \case
Nothing -> SGR [35,1] "Anonymous"
-renderTags :: [T.Text] -> Trammel String
-renderTags ts =
- Plain $ T.unpack $ T.intercalate " " ts
+renderTags :: [Tag] -> Trammel String
+renderTags =
+ Plain . T.unpack . T.intercalate " " . L.sort
dropAddress :: String -> String
diff --git a/test5.hs b/test5.hs
index 0d8aa6b..470e780 100644
--- a/test5.hs
+++ b/test5.hs
@@ -212,6 +212,8 @@ redraw q@State{..} = do
keymap :: String -> State -> IO State
+keymap "a" = toggleTagAtCursor "inbox"
+keymap "s" = toggleTagAtCursor "unread"
keymap "r" = replyToAll
keymap "e" = viewSource
keymap "t" = editTags
@@ -334,8 +336,8 @@ moveToParent q@State{..} =
toggleFold :: State -> IO State
toggleFold q@State{..} = case Z.label cursor of
- TVMessage m -> do
- toggleTag (T.pack "open") m
+ TVMessage _ -> do
+ q' <- toggleTagAtCursor "open" q
let Just sr = findParent isTVSearchResult cursor
TVSearchResult the_sr = Z.label sr
@@ -344,7 +346,7 @@ toggleFold q@State{..} = case Z.label cursor of
t_ <- return . fromMessageForest =<< Notmuch.getThread tid
let cursor' = Z.modifyTree (\(Tree.Node l _) -> Tree.Node l t_) sr
- return q { cursor = select (==Z.label cursor) cursor' }
+ return q' { cursor = select (==Z.label cursor) cursor' }
TVSearchResult sr -> do
let open = not $ null $ Tree.subForest $ Z.tree cursor
@@ -363,18 +365,23 @@ toggleFold q@State{..} = case Z.label cursor of
where
select p loc = fromMaybe (error "cannot select") $ findTree p $ Z.root loc
- toggleTag :: T.Text -> Notmuch.Message -> IO ()
- toggleTag tag m = do
- _ <- if tag `elem` Notmuch.messageTags m
- then
- Notmuch.unsetTag tagString (Notmuch.unMessageID $ Notmuch.messageId m)
- else
- Notmuch.setTag tagString (Notmuch.unMessageID $ Notmuch.messageId m)
- return ()
- where
- tagString = T.unpack tag
-
+toggleTagAtCursor :: Tag -> State -> IO State
+toggleTagAtCursor tag q@State{..} = case Z.label cursor of
+ TVMessage m -> do
+ -- TODO modify search result tags
+ -- TODO check Notmuch.{set,unset}Tag result
+ if tag `elem` Notmuch.messageTags m
+ then do
+ Notmuch.unsetTag (T.unpack tag) (Notmuch.unMessageID $ Notmuch.messageId m)
+ let cursor' = Z.modifyTree (patchRootLabelTags [DelTag tag]) cursor
+ return q { cursor = cursor' }
+ else do
+ Notmuch.setTag (T.unpack tag) (Notmuch.unMessageID $ Notmuch.messageId m)
+ let cursor' = Z.modifyTree (patchRootLabelTags [AddTag tag]) cursor
+ return q { cursor = cursor' }
+
+ _ -> return q { flashMessage = "nothing happened" }
replyToAll :: State -> IO State