{-# 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
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
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
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
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 ([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 :: 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 = [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
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