{-# 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 a
-- refresh-based monitor.
--
-- 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)
import Text.Read (Lexeme(Ident), ReadPrec, lexP, parens, prec, readPrec, reset)


-- | A 'MailItem' is a name, an address, and a query to give to @notmuch@.
data MailItem = MailItem
  { MailItem -> String
name    :: String  -- ^ Display name for the item in the bar
  , MailItem -> String
address :: String  -- ^ Only check for mail sent to this address; may be
                       --   the empty string to query all indexed mail instead
  , MailItem -> String
query   :: String  -- ^ Query to give to @notmuch search@
  }
  deriving (Int -> MailItem -> ShowS
[MailItem] -> ShowS
MailItem -> String
(Int -> MailItem -> ShowS)
-> (MailItem -> String) -> ([MailItem] -> ShowS) -> Show MailItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MailItem] -> ShowS
$cshowList :: [MailItem] -> ShowS
show :: MailItem -> String
$cshow :: MailItem -> String
showsPrec :: Int -> MailItem -> ShowS
$cshowsPrec :: Int -> MailItem -> ShowS
Show)

instance Read MailItem where
  readPrec :: ReadPrec MailItem
  readPrec :: ReadPrec MailItem
readPrec = ReadPrec MailItem -> ReadPrec MailItem
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec MailItem -> ReadPrec MailItem)
-> (ReadPrec MailItem -> ReadPrec MailItem)
-> ReadPrec MailItem
-> ReadPrec MailItem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec MailItem -> ReadPrec MailItem
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 (ReadPrec MailItem -> ReadPrec MailItem)
-> ReadPrec MailItem -> ReadPrec MailItem
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"MailItem" <- ReadPrec Lexeme
lexP
    String -> String -> String -> MailItem
MailItem (String -> String -> String -> MailItem)
-> ReadPrec String -> ReadPrec (String -> String -> MailItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String -> ReadPrec String
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec String
forall a. Read a => ReadPrec a
readPrec ReadPrec (String -> String -> MailItem)
-> ReadPrec String -> ReadPrec (String -> MailItem)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec String -> ReadPrec String
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec String
forall a. Read a => ReadPrec a
readPrec ReadPrec (String -> MailItem)
-> ReadPrec String -> ReadPrec MailItem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec String -> ReadPrec String
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec String
forall a. Read a => ReadPrec a
readPrec

-- | A full mail configuration.
data NotmuchMail = NotmuchMail
  { NotmuchMail -> String
nmAlias   :: String      -- ^ Alias for the template string
  , NotmuchMail -> [MailItem]
mailItems :: [MailItem]  -- ^ 'MailItem's to check
  , NotmuchMail -> Int
nmRate    :: Int         -- ^ Update frequency (in deciseconds)
  }
  deriving (Int -> NotmuchMail -> ShowS
[NotmuchMail] -> ShowS
NotmuchMail -> String
(Int -> NotmuchMail -> ShowS)
-> (NotmuchMail -> String)
-> ([NotmuchMail] -> ShowS)
-> Show NotmuchMail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NotmuchMail] -> ShowS
$cshowList :: [NotmuchMail] -> ShowS
show :: NotmuchMail -> String
$cshow :: NotmuchMail -> String
showsPrec :: Int -> NotmuchMail -> ShowS
$cshowsPrec :: Int -> NotmuchMail -> ShowS
Show)

instance Read NotmuchMail where
  readPrec :: ReadPrec NotmuchMail
  readPrec :: ReadPrec NotmuchMail
readPrec = ReadPrec NotmuchMail -> ReadPrec NotmuchMail
forall a. ReadPrec a -> ReadPrec a
parens (ReadPrec NotmuchMail -> ReadPrec NotmuchMail)
-> (ReadPrec NotmuchMail -> ReadPrec NotmuchMail)
-> ReadPrec NotmuchMail
-> ReadPrec NotmuchMail
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ReadPrec NotmuchMail -> ReadPrec NotmuchMail
forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 (ReadPrec NotmuchMail -> ReadPrec NotmuchMail)
-> ReadPrec NotmuchMail -> ReadPrec NotmuchMail
forall a b. (a -> b) -> a -> b
$ do
    Ident String
"NotmuchMail" <- ReadPrec Lexeme
lexP
    String -> [MailItem] -> Int -> NotmuchMail
NotmuchMail (String -> [MailItem] -> Int -> NotmuchMail)
-> ReadPrec String -> ReadPrec ([MailItem] -> Int -> NotmuchMail)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadPrec String -> ReadPrec String
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec String
forall a. Read a => ReadPrec a
readPrec ReadPrec ([MailItem] -> Int -> NotmuchMail)
-> ReadPrec [MailItem] -> ReadPrec (Int -> NotmuchMail)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec [MailItem] -> ReadPrec [MailItem]
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec [MailItem]
forall a. Read a => ReadPrec a
readPrec ReadPrec (Int -> NotmuchMail)
-> ReadPrec Int -> ReadPrec NotmuchMail
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadPrec Int -> ReadPrec Int
forall a. ReadPrec a -> ReadPrec a
reset ReadPrec Int
forall a. Read a => ReadPrec a
readPrec

-- | How to execute this plugin.
instance Exec NotmuchMail where
  -- | How often to update the plugin (in deciseconds).
  rate :: NotmuchMail -> Int
  rate :: NotmuchMail -> Int
rate NotmuchMail{ Int
nmRate :: Int
nmRate :: NotmuchMail -> Int
nmRate } = Int
nmRate

  -- | How to alias the plugin in the template string.
  alias :: NotmuchMail -> String
  alias :: NotmuchMail -> String
alias NotmuchMail{ String
nmAlias :: String
nmAlias :: NotmuchMail -> String
nmAlias } = String
nmAlias

  -- | Run the plugin exactly once.
  run :: NotmuchMail -> IO String
  run :: NotmuchMail -> IO String
run NotmuchMail{ [MailItem]
mailItems :: [MailItem]
mailItems :: NotmuchMail -> [MailItem]
mailItems } =
    [String] -> String
unwords ([String] -> String)
-> ([Maybe String] -> [String]) -> [Maybe String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe String] -> String) -> IO [Maybe String] -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (MailItem -> IO (Maybe String)) -> [MailItem] -> IO [Maybe String]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently MailItem -> IO (Maybe String)
notmuchSpawn [MailItem]
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.
    MailItem -> IO (Maybe String)
notmuchSpawn :: MailItem -> IO (Maybe String)
      = \MailItem{ String
address :: String
address :: MailItem -> String
address, String
name :: String
name :: MailItem -> String
name, String
query :: String
query :: MailItem -> String
query } -> do
          -- Shell out to @notmuch@
          let args :: [String]
args = [ String
"search"
                     , String -> ShowS
tryAdd String
"to:" String
address
                     , String
"tag:unread", String -> ShowS
tryAdd String
"and " String
query
                     ]
          (ExitCode
exitCode, String
out, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"notmuch" [String]
args []

          -- Only print something when there is at least _some_ new mail
          let numThreads :: Int
numThreads = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
out)
          Maybe String -> IO (Maybe String)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe String -> IO (Maybe String))
-> Maybe String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$!
            (String
name String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) ShowS -> (Int -> String) -> Int -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Maybe Int -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if   ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess Bool -> Bool -> Bool
|| Int
numThreads Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1
                                 then Maybe Int
forall a. Maybe a
Nothing
                                 else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
numThreads

    -- | Only add something to a 'String' if it's not empty.
    String -> ShowS
tryAdd :: String -> String -> String
      = \String
prefix String
str -> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str then String
"" else String
prefix String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
str