summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar
diff options
context:
space:
mode:
Diffstat (limited to 'src/Xmobar')
-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