Notmuch: replace {un,}setTag by notmuchTag

8 files changed, 104 insertions, 77 deletions

diff --git a/Notmuch.hs b/Notmuch.hs
index c39c4c0..eb839fd 100644
--- a/Notmuch.hs
+++ b/Notmuch.hs
@@ -10,11 +10,13 @@ import Control.Exception
 import Data.Aeson
 import Data.Monoid
 import Data.Tree
+import Notmuch.Class
 import Notmuch.Message
 import Notmuch.SearchResult
 import System.Exit
 import System.IO
 import System.Process
+import TagUtils
 
 
 -- | Fork a thread while doing something else, but kill it if there's an
@@ -177,11 +179,6 @@ notmuchShowPart term partId = do
         _ -> Left $ show exitCode <> ": " <> LBS8.unpack err
 
 
-setTag :: String -> String -> IO LBS.ByteString
-setTag tag i = do
-    notmuch [ "tag", "+" <> tag , i ]
-
-
-unsetTag :: String -> String -> IO LBS.ByteString
-unsetTag tag i = do
-    notmuch [ "tag", "-" <> tag , i ]
+notmuchTag :: HasNotmuchId a => [TagOp] -> a -> IO ()
+notmuchTag tagOps x =
+    notmuch ("tag" : tagOpsToArgs tagOps ++ [notmuchId x]) >> return ()
diff --git a/Notmuch/Class.hs b/Notmuch/Class.hs
new file mode 100644
index 0000000..2d2b416
--- /dev/null
+++ b/Notmuch/Class.hs
@@ -0,0 +1,4 @@
+module Notmuch.Class where
+
+class HasNotmuchId a where
+    notmuchId :: a -> String
diff --git a/Notmuch/Message.hs b/Notmuch/Message.hs
index 29ca5ec..dd1e809 100644
--- a/Notmuch/Message.hs
+++ b/Notmuch/Message.hs
@@ -9,6 +9,7 @@ import Data.Time.Calendar
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
 import Data.Monoid
+import Notmuch.Class
 import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.CaseInsensitive as CI
@@ -88,6 +89,9 @@ instance Eq Message where
     a == b = messageId a == messageId b
 
 
+instance HasNotmuchId Message where
+    notmuchId = unMessageID . messageId
+
 
 instance FromJSON Message where
     parseJSON (Object v) = Message <$> (MessageID . ("id:"<>) <$> v .: "id")
diff --git a/Notmuch/SearchResult.hs b/Notmuch/SearchResult.hs
index 3a75e96..52b8c20 100644
--- a/Notmuch/SearchResult.hs
+++ b/Notmuch/SearchResult.hs
@@ -7,6 +7,7 @@ import Data.Aeson
 import Data.Text
 import Data.Time.Clock
 import Data.Time.Clock.POSIX
+import Notmuch.Class
 
 
 newtype ThreadID = ThreadID { unThreadID :: String }
@@ -33,6 +34,10 @@ instance Eq SearchResult where
         searchThread s1 == searchThread s2
 
 
+instance HasNotmuchId SearchResult where
+    notmuchId = unThreadID . searchThread
+
+
 instance FromJSON SearchResult where
     parseJSON (Object v) = SearchResult <$> ((ThreadID . ("thread:"++)) <$> v .: "thread")
                                         <*> (posixSecondsToUTCTime . fromInteger <$> v .: "timestamp")
diff --git a/TagUtils.hs b/TagUtils.hs
index a5df807..e8f17eb 100644
--- a/TagUtils.hs
+++ b/TagUtils.hs
@@ -12,7 +12,7 @@ import Data.Monoid
 import Data.Tree
 import Notmuch.Message
 import Notmuch.SearchResult
-import TreeView
+import TreeView.Types
 
 
 type Tag = T.Text
diff --git a/TreeView.hs b/TreeView.hs
index 470913b..dff50e8 100644
--- a/TreeView.hs
+++ b/TreeView.hs
@@ -4,7 +4,7 @@
 
 
 module TreeView
-    ( TreeView (..)
+    ( module Export
     , getMessage
     , getSearchTerm
     , isTVMessage
@@ -12,14 +12,12 @@ module TreeView
     , fromSearchResults
     , fromMessageForest
     , fromMessageTree
-    , treeViewId
     , loadSubForest
     , unloadSubForest
     , hasUnloadedSubForest
     ) where
 
 
-import qualified Data.CaseInsensitive as CI
 import qualified Data.Text as T
 import Control.Applicative
 import Data.Monoid
@@ -27,61 +25,7 @@ import Data.Tree
 import Notmuch
 import Notmuch.Message
 import Notmuch.SearchResult
-
-
-type LineNr = Int
-
-
-data TreeView
-    = TVMessage Message
-    | TVMessageHeaderField Message (CI.CI T.Text)
-    | TVMessagePart Message MessagePart
-    | TVMessageQuoteLine Message MessagePart LineNr String
-    | TVMessageLine Message MessagePart LineNr String
-    | TVSearch String
-    | TVSearchResult SearchResult
-  deriving (Show)
-
-
-instance Eq TreeView where
-    x1 == x2 = treeViewId x1 == treeViewId x2
-
-
-data TreeViewId
-    = TVIDMessage T.Text
-    | TVIDMessageHeaderField T.Text T.Text
-    | TVIDMessagePart T.Text Int
-    | TVIDMessageLine T.Text Int Int
-    | TVIDSearch T.Text
-    | TVIDSearchResult T.Text
-  deriving (Eq,Show)
-
-
-treeViewId :: TreeView -> TreeViewId
-treeViewId = \case
-    TVMessage m ->
-        TVIDMessage (fromMessage m)
-
-    TVMessageHeaderField m mhf ->
-        TVIDMessageHeaderField (fromMessage m) (CI.foldedCase mhf)
-
-    TVMessagePart m mp ->
-        TVIDMessagePart (fromMessage m) (partID mp)
-
-    TVMessageLine m mp lineNr _ ->
-        TVIDMessageLine (fromMessage m) (partID mp) lineNr
-
-    TVMessageQuoteLine m mp lineNr _ ->
-        TVIDMessageLine (fromMessage m) (partID mp) lineNr
-
-    TVSearch s ->
-        TVIDSearch (T.pack s)
-
-    TVSearchResult sr ->
-        TVIDSearchResult (T.pack $ unThreadID $ searchThread sr)
-
-  where
-    fromMessage = T.pack . unMessageID . messageId
+import TreeView.Types as Export
 
 
 getMessage :: TreeView -> Maybe Message
diff --git a/TreeView/Types.hs b/TreeView/Types.hs
new file mode 100644
index 0000000..0dd1290
--- /dev/null
+++ b/TreeView/Types.hs
@@ -0,0 +1,63 @@
+{-# LANGUAGE LambdaCase #-}
+
+module TreeView.Types where
+
+import qualified Data.CaseInsensitive as CI
+import qualified Data.Text as T
+import Notmuch.Message
+import Notmuch.SearchResult
+
+
+type LineNr = Int
+
+
+data TreeView
+    = TVMessage Message
+    | TVMessageHeaderField Message (CI.CI T.Text)
+    | TVMessagePart Message MessagePart
+    | TVMessageQuoteLine Message MessagePart LineNr String
+    | TVMessageLine Message MessagePart LineNr String
+    | TVSearch String
+    | TVSearchResult SearchResult
+  deriving (Show)
+
+
+instance Eq TreeView where
+    x1 == x2 = treeViewId x1 == treeViewId x2
+
+
+data TreeViewId
+    = TVIDMessage T.Text
+    | TVIDMessageHeaderField T.Text T.Text
+    | TVIDMessagePart T.Text Int
+    | TVIDMessageLine T.Text Int Int
+    | TVIDSearch T.Text
+    | TVIDSearchResult T.Text
+  deriving (Eq,Show)
+
+
+treeViewId :: TreeView -> TreeViewId
+treeViewId = \case
+    TVMessage m ->
+        TVIDMessage (fromMessage m)
+
+    TVMessageHeaderField m mhf ->
+        TVIDMessageHeaderField (fromMessage m) (CI.foldedCase mhf)
+
+    TVMessagePart m mp ->
+        TVIDMessagePart (fromMessage m) (partID mp)
+
+    TVMessageLine m mp lineNr _ ->
+        TVIDMessageLine (fromMessage m) (partID mp) lineNr
+
+    TVMessageQuoteLine m mp lineNr _ ->
+        TVIDMessageLine (fromMessage m) (partID mp) lineNr
+
+    TVSearch s ->
+        TVIDSearch (T.pack s)
+
+    TVSearchResult sr ->
+        TVIDSearchResult (T.pack $ unThreadID $ searchThread sr)
+
+  where
+    fromMessage = T.pack . unMessageID . messageId
diff --git a/test5.hs b/test5.hs
index b9ca124..4133e76 100644
--- a/test5.hs
+++ b/test5.hs
@@ -422,18 +422,28 @@ toggleFold q@State{..} =
 
 toggleTagAtCursor :: Tag -> State -> IO State
 toggleTagAtCursor tag q@State{..} = case Z.label cursor of
+
+    TVSearchResult sr -> do
+        let tagOp =
+                if tag `elem` Notmuch.searchTags sr
+                    then DelTag
+                    else AddTag
+            tagOps = [tagOp tag]
+        Notmuch.notmuchTag tagOps sr
+        -- TODO reload or patch whole thread
+        let cursor' = Z.modifyTree (patchRootLabelTags tagOps) cursor
+        return q { cursor = cursor' }
+
     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' }
+        let tagOp =
+                if tag `elem` Notmuch.messageTags m
+                    then DelTag
+                    else AddTag
+            tagOps = [tagOp tag]
+        Notmuch.notmuchTag tagOps m
+        let cursor' = Z.modifyTree (patchRootLabelTags tagOps) cursor
+        return q { cursor = cursor' }
 
     _ -> return q { flashMessage = "nothing happened" }