summaryrefslogtreecommitdiffstats
path: root/TagUtils.hs
diff options
context:
space:
mode:
authorKierán Meinhardt <kieran.meinhardt@gmail.com>2020-09-23 17:44:40 +0200
committerKierán Meinhardt <kieran.meinhardt@gmail.com>2020-09-23 17:44:40 +0200
commit8e92e6e11d2b3b0bfb5ac9d68f347219493e6380 (patch)
tree6484ca42d85ca89475e922f7b45039c116ebbf97 /TagUtils.hs
parent6a6ad3aecd53ffd89101a0dee2b4ea576d4964d4 (diff)
split into library + executables
Diffstat (limited to 'TagUtils.hs')
-rw-r--r--TagUtils.hs62
1 files changed, 0 insertions, 62 deletions
diff --git a/TagUtils.hs b/TagUtils.hs
deleted file mode 100644
index 99d957d..0000000
--- a/TagUtils.hs
+++ /dev/null
@@ -1,62 +0,0 @@
-{-# LANGUAGE LambdaCase #-}
-
-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.Tree
-import Notmuch.Message
-import Notmuch.SearchResult
-import 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)