summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/Plugins
diff options
context:
space:
mode:
authorslotThe <soliditsallgood@mailbox.org>2020-11-26 10:24:23 +0100
committerslotThe <soliditsallgood@mailbox.org>2020-11-29 18:56:35 +0100
commit5c20da743b34f05ea25f3b4de60ba5e570fc264f (patch)
treea99f1530c95dd6e856c746a40f329aad277f19e5 /src/Xmobar/Plugins
parent779bc598aa5f33e74cae5d6f5d28aab7f49b5c85 (diff)
downloadxmobar-5c20da743b34f05ea25f3b4de60ba5e570fc264f.tar.gz
xmobar-5c20da743b34f05ea25f3b4de60ba5e570fc264f.tar.bz2
Add new plugin: NotmuchMail
This plugin checks for new mail, provided that this mail is indexed by notmuch. As mail that was tagged is moved from the new directory to cur, the 'Mail' plugin (and its variants) won't work for such mail.
Diffstat (limited to 'src/Xmobar/Plugins')
-rw-r--r--src/Xmobar/Plugins/NotmuchMail.hs96
1 files changed, 96 insertions, 0 deletions
diff --git a/src/Xmobar/Plugins/NotmuchMail.hs b/src/Xmobar/Plugins/NotmuchMail.hs
new file mode 100644
index 0000000..4544a81
--- /dev/null
+++ b/src/Xmobar/Plugins/NotmuchMail.hs
@@ -0,0 +1,96 @@
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module : Xmobar.Plugins.NotmuchMail
+-- Copyright : (c) slotThe
+-- License : BSD-style (see LICENSE)
+--
+-- Maintainer : slotThe <soliditsallgood@mailbox.org>
+-- Stability : unstable
+-- Portability : unportable
+--
+-- This plugin checks for new mail, provided that this mail is indexed
+-- by @notmuch@. You can think of it as a thin wrapper around the
+-- functionality provided by @notmuch search@.
+--
+-- As mail that was tagged is moved from the @new@ directory to @cur@,
+-- the @inotify@ solution that he mail 'Mail' plugin (and its variants)
+-- uses won't work for such mail. Hence we have to resort to refreshing
+-- every N time intervals.
+--
+-- Note that, in the `notmuch` spirit, this plugin checks for new
+-- threads and not new individual messages. For convenience, the
+-- @unread@ tag is added before the user query (compose via an @and@).
+--
+-----------------------------------------------------------------------------
+
+module Xmobar.Plugins.NotmuchMail
+ ( -- * Types
+ MailItem(..) -- instances: Read, Show
+ , NotmuchMail(..) -- instances: Read, Show
+ ) where
+
+import Xmobar.Run.Exec (Exec(alias, rate, run))
+
+import Control.Concurrent.Async (mapConcurrently)
+import Data.Maybe (catMaybes)
+import System.Exit (ExitCode(ExitSuccess))
+import System.Process (readProcessWithExitCode)
+
+
+-- | A 'MailItem' is a name, an address, and a query to give to @notmuch@.
+data MailItem = MailItem
+ { name :: String -- ^ Display name for the item in the bar
+ , address :: String -- ^ Only check for mail sent to this address; may be
+ -- the empty string to query all indexed mail instead
+ , query :: String -- ^ Query to give to @notmuch search@
+ }
+ deriving (Read, Show)
+
+-- | A full mail configuration.
+data NotmuchMail = NotmuchMail
+ { nmAlias :: String -- ^ Alias for the template string
+ , mailItems :: [MailItem] -- ^ 'MailItem's to check
+ , nmRate :: Int -- ^ Update frequency (in deciseconds)
+ }
+ deriving (Read, Show)
+
+-- | How to execute this plugin.
+instance Exec NotmuchMail where
+ -- | How often to update the plugin (in deciseconds).
+ rate :: NotmuchMail -> Int
+ rate NotmuchMail{ nmRate } = nmRate
+
+ -- | How to alias the plugin in the template string.
+ alias :: NotmuchMail -> String
+ alias NotmuchMail{ nmAlias } = nmAlias
+
+ -- | Run the plugin exactly once.
+ run :: NotmuchMail -> IO String
+ run NotmuchMail{ mailItems } =
+ unwords . catMaybes <$> mapConcurrently notmuchSpawn mailItems
+ where
+ -- | Given a single 'MailItem', shell out to @notmuch@ and get the number
+ -- of unread mails, then decide whether what we have is worth printing.
+ notmuchSpawn :: MailItem -> IO (Maybe String)
+ = \MailItem{ address, name, query } -> do
+ -- Shell out to @notmuch@
+ let args = [ "search"
+ , tryAdd "to:" address
+ , "tag:unread", tryAdd "and " query
+ ]
+ (exitCode, out, _) <- readProcessWithExitCode "notmuch" args []
+
+ -- Only print something when there is at least _some_ new mail
+ let numThreads = length (lines out)
+ pure $!
+ (name <>) . show <$> if exitCode /= ExitSuccess || numThreads < 1
+ then Nothing
+ else Just numThreads
+
+ -- | Only add something to a 'String' if it's not empty.
+ tryAdd :: String -> String -> String
+ = \prefix str -> if null str then "" else prefix <> str