summaryrefslogtreecommitdiffstats
path: root/TagUtils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'TagUtils.hs')
-rw-r--r--TagUtils.hs65
1 files changed, 65 insertions, 0 deletions
diff --git a/TagUtils.hs b/TagUtils.hs
new file mode 100644
index 0000000..3befad9
--- /dev/null
+++ b/TagUtils.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module TagUtils where
+
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import Data.Char
+import Data.List.Split (wordsBy)
+import Data.Monoid
+import Data.Tree
+import Notmuch.Message
+import Notmuch.SearchResult
+import TreeView
+
+
+type Tag = T.Text
+
+
+data TagOp = AddTag Tag | DelTag Tag
+
+
+parseTags :: String -> [Tag]
+parseTags =
+ mconcat . map (map T.pack . wordsBy isSpace . takeWhile (/='#')) . lines
+
+
+diffTags :: [Tag] -> [Tag] -> [TagOp]
+diffTags old new =
+ let oldTags = Set.fromList old
+ newTags = Set.fromList new
+ in (map DelTag $ Set.toList $ oldTags `Set.difference` newTags) ++
+ (map AddTag $ Set.toList $ newTags `Set.difference` oldTags)
+
+
+patchRootLabelTags :: [TagOp] -> Tree TreeView -> Tree TreeView
+patchRootLabelTags tagOps x =
+ x { rootLabel = patchTags tagOps $ rootLabel x }
+
+
+patchTreeTags :: [TagOp] -> Tree TreeView -> Tree TreeView
+patchTreeTags tagOps =
+ fmap (patchTags tagOps)
+
+
+tagOpsToArgs :: [TagOp] -> [String]
+tagOpsToArgs = map $ \case
+ AddTag t -> '+' : T.unpack t
+ DelTag t -> '-' : T.unpack t
+
+
+patchTags :: [TagOp] -> TreeView -> TreeView
+patchTags tagOps = \case
+ TVSearchResult sr ->
+ TVSearchResult $ sr { searchTags = foldr applyTagOp (searchTags sr) tagOps }
+ TVMessage m ->
+ TVMessage $ m { messageTags = foldr applyTagOp (messageTags m) tagOps }
+ x -> x -- nop
+
+
+applyTagOp :: TagOp -> [Tag] -> [Tag]
+applyTagOp = \case
+ AddTag t -> (t:)
+ DelTag t -> filter (/=t)