{-# 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
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 = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 forall a b. (a -> b) -> a -> b
$ do
Ident String
"MailItem" <- ReadPrec Lexeme
lexP
String -> String -> String -> MailItem
MailItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
data NotmuchMail = NotmuchMail
{ NotmuchMail -> String
nmAlias :: String
, NotmuchMail -> [MailItem]
mailItems :: [MailItem]
, NotmuchMail -> Int
nmRate :: Int
}
deriving (Int -> NotmuchMail -> ShowS
[NotmuchMail] -> ShowS
NotmuchMail -> String
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 = forall a. ReadPrec a -> ReadPrec a
parens forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> ReadPrec a -> ReadPrec a
prec Int
11 forall a b. (a -> b) -> a -> b
$ do
Ident String
"NotmuchMail" <- ReadPrec Lexeme
lexP
String -> [MailItem] -> Int -> NotmuchMail
NotmuchMail forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadPrec a -> ReadPrec a
reset forall a. Read a => ReadPrec a
readPrec
instance Exec NotmuchMail where
rate :: NotmuchMail -> Int
rate :: NotmuchMail -> Int
rate NotmuchMail{ Int
nmRate :: Int
nmRate :: NotmuchMail -> Int
nmRate } = Int
nmRate
alias :: NotmuchMail -> String
alias :: NotmuchMail -> String
alias NotmuchMail{ String
nmAlias :: String
nmAlias :: NotmuchMail -> String
nmAlias } = String
nmAlias
run :: NotmuchMail -> IO String
run :: NotmuchMail -> IO String
run NotmuchMail{ [MailItem]
mailItems :: [MailItem]
mailItems :: NotmuchMail -> [MailItem]
mailItems } =
[String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 :: String
address :: MailItem -> String
address, String
name :: String
name :: MailItem -> String
name, String
query :: String
query :: MailItem -> 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
exitCode, String
out, String
_) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"notmuch" [String]
args []
let numThreads :: Int
numThreads = forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> [String]
lines String
out)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$!
(String
name forall a. Semigroup a => a -> a -> a
<>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if ExitCode
exitCode forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess Bool -> Bool -> Bool
|| Int
numThreads forall a. Ord a => a -> a -> Bool
< Int
1
then forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just Int
numThreads
String -> ShowS
tryAdd :: String -> String -> String
= \String
prefix String
str -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str then String
"" else String
prefix forall a. Semigroup a => a -> a -> a
<> String
str