From 8e92e6e11d2b3b0bfb5ac9d68f347219493e6380 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kier=C3=A1n=20Meinhardt?= <kieran.meinhardt@gmail.com>
Date: Wed, 23 Sep 2020 17:44:40 +0200
Subject: split into library + executables

---
 src/Much/TagUtils.hs | 62 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 62 insertions(+)
 create mode 100644 src/Much/TagUtils.hs

(limited to 'src/Much/TagUtils.hs')

diff --git a/src/Much/TagUtils.hs b/src/Much/TagUtils.hs
new file mode 100644
index 0000000..d4e4d30
--- /dev/null
+++ b/src/Much/TagUtils.hs
@@ -0,0 +1,62 @@
+{-# LANGUAGE LambdaCase #-}
+
+module Much.TagUtils where
+
+import qualified Data.Set as Set
+import qualified Data.Text as T
+import Data.Char
+import Data.List.Split (wordsBy)
+import Data.Tree
+import Notmuch.Message
+import Notmuch.SearchResult
+import Much.TreeView.Types
+
+
+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)
-- 
cgit v1.2.3

[cgit] Unable to lock slot /tmp/cgit/95300000.lock: Permission denied (13)