{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Xmobar.Plugins.NotmuchMail
(
MailItem(..)
, NotmuchMail(..)
) 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)
data MailItem = MailItem
{ MailItem -> String
name :: String
, MailItem -> String
address :: String
, MailItem -> String
query :: String
}
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
$cshowsPrec :: Int -> MailItem -> ShowS
showsPrec :: Int -> MailItem -> ShowS
$cshow :: MailItem -> String
show :: MailItem -> String
$cshowList :: [MailItem] -> ShowS
showList :: [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 "MailItem" <- ReadPrec Lexeme
lexP
MailItem <$> reset readPrec <*> reset readPrec <*> reset readPrec
data NotmuchMail = NotmuchMail
{ NotmuchMail -> String
nmAlias :: String
, NotmuchMail -> [MailItem]
mailItems :: [MailItem]
, NotmuchMail -> Int
nmRate :: Int
}
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
$cshowsPrec :: Int -> NotmuchMail -> ShowS
showsPrec :: Int -> NotmuchMail -> ShowS
$cshow :: NotmuchMail -> String
show :: NotmuchMail -> String
$cshowList :: [NotmuchMail] -> ShowS
showList :: [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 "NotmuchMail" <- ReadPrec Lexeme
lexP
NotmuchMail <$> reset readPrec <*> reset readPrec <*> reset readPrec
instance Exec NotmuchMail where
rate :: NotmuchMail -> Int
rate :: NotmuchMail -> Int
rate NotmuchMail{ Int
nmRate :: NotmuchMail -> Int
nmRate :: Int
nmRate } = Int
nmRate
alias :: NotmuchMail -> String
alias :: NotmuchMail -> String
alias NotmuchMail{ String
nmAlias :: NotmuchMail -> String
nmAlias :: String
nmAlias } = String
nmAlias
run :: NotmuchMail -> IO String
run :: NotmuchMail -> IO String
run NotmuchMail{ [MailItem]
mailItems :: NotmuchMail -> [MailItem]
mailItems :: [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
MailItem -> IO (Maybe String)
notmuchSpawn :: MailItem -> IO (Maybe String)
= \MailItem{ String
address :: MailItem -> String
address :: String
address, String
name :: MailItem -> String
name :: String
name, String
query :: MailItem -> String
query :: String
query } -> do
let args :: [String]
args = [ String
"search"
, String -> ShowS
tryAdd String
"to:" String
address
, String
"tag:unread", String -> ShowS
tryAdd String
"and " String
query
]
(exitCode, out, _) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"notmuch" [String]
args []
let numThreads = [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
out)
pure $!
(name <>) . show <$> if exitCode /= ExitSuccess || numThreads < 1
then Nothing
else Just numThreads
String -> ShowS
tryAdd :: String -> String -> String
= \String
prefix String
str -> if String -> Bool
forall a. [a] -> 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