diff options
Diffstat (limited to 'src/Xmobar')
| -rw-r--r-- | src/Xmobar/Plugins/NotmuchMail.hs | 96 |
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 |