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.

2 files changed, 98 insertions, 0 deletions

diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index d2e4126..f37f065 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -39,6 +39,7 @@ module Xmobar (xmobar
               , module Xmobar.Plugins.Mail
               , module Xmobar.Plugins.MBox
 #endif
+              , module Xmobar.Plugins.NotmuchMail
               , module Xmobar.Plugins.Monitors
               , module Xmobar.Plugins.PipeReader
               , module Xmobar.Plugins.MarqueePipeReader
@@ -70,6 +71,7 @@ import Xmobar.Plugins.PipeReader
 import Xmobar.Plugins.StdinReader
 import Xmobar.Plugins.MarqueePipeReader
 import Xmobar.Plugins.XMonadLog
+import Xmobar.Plugins.NotmuchMail
 
 import Xmobar.App.Main(xmobar, xmobarMain, configFromArgs)
 import Xmobar.App.Config(defaultConfig)
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