{-# LANGUAGE CPP #-}
module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where
import Xmobar.Run.Exec
#ifdef INOTIFY
import Xmobar.Plugins.Monitors.Common (parseOptsWith)
import Xmobar.System.Utils (expandHome, changeLoop)
import Control.Monad
import Control.Concurrent.STM
import System.Directory
import System.FilePath
import System.INotify
import System.Console.GetOpt
import Data.List (isPrefixOf)
import Data.Set (Set)
import qualified Data.Set as S
#if MIN_VERSION_hinotify(0,3,10)
import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack)
unpack :: BS.ByteString -> String
unpack :: ByteString -> String
unpack = ByteString -> String
BS.unpack
pack :: String -> BS.ByteString
pack :: String -> ByteString
pack = String -> ByteString
BS.pack
#else
unpack :: String -> String
unpack = id
pack :: String -> String
pack = id
#endif
#else
import System.IO
#endif
data MOptions = MOptions
{ MOptions -> String
oDir :: FilePath
, MOptions -> String
oPrefix :: String
, MOptions -> String
oSuffix :: String
}
defaults :: MOptions
defaults :: MOptions
defaults = MOptions {oDir :: String
oDir = String
"", oPrefix :: String
oPrefix = String
"", oSuffix :: String
oSuffix = String
""}
options :: [OptDescr (MOptions -> MOptions)]
options :: [OptDescr (MOptions -> MOptions)]
options =
[ String
-> [String]
-> ArgDescr (MOptions -> MOptions)
-> String
-> OptDescr (MOptions -> MOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"d" [String
"dir"] ((String -> MOptions -> MOptions)
-> String -> ArgDescr (MOptions -> MOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOptions
o -> MOptions
o { oDir = x }) String
"") String
""
, String
-> [String]
-> ArgDescr (MOptions -> MOptions)
-> String
-> OptDescr (MOptions -> MOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"prefix"] ((String -> MOptions -> MOptions)
-> String -> ArgDescr (MOptions -> MOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOptions
o -> MOptions
o { oPrefix = x }) String
"") String
""
, String
-> [String]
-> ArgDescr (MOptions -> MOptions)
-> String
-> OptDescr (MOptions -> MOptions)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"s" [String
"suffix"] ((String -> MOptions -> MOptions)
-> String -> ArgDescr (MOptions -> MOptions)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x MOptions
o -> MOptions
o { oSuffix = x }) String
"") String
""
]
data Mail = Mail [(String, FilePath)] String
deriving (ReadPrec [Mail]
ReadPrec Mail
Int -> ReadS Mail
ReadS [Mail]
(Int -> ReadS Mail)
-> ReadS [Mail] -> ReadPrec Mail -> ReadPrec [Mail] -> Read Mail
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Mail
readsPrec :: Int -> ReadS Mail
$creadList :: ReadS [Mail]
readList :: ReadS [Mail]
$creadPrec :: ReadPrec Mail
readPrec :: ReadPrec Mail
$creadListPrec :: ReadPrec [Mail]
readListPrec :: ReadPrec [Mail]
Read, Int -> Mail -> ShowS
[Mail] -> ShowS
Mail -> String
(Int -> Mail -> ShowS)
-> (Mail -> String) -> ([Mail] -> ShowS) -> Show Mail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Mail -> ShowS
showsPrec :: Int -> Mail -> ShowS
$cshow :: Mail -> String
show :: Mail -> String
$cshowList :: [Mail] -> ShowS
showList :: [Mail] -> ShowS
Show)
data MailX = MailX [(String, FilePath, String)] [String] String
deriving (ReadPrec [MailX]
ReadPrec MailX
Int -> ReadS MailX
ReadS [MailX]
(Int -> ReadS MailX)
-> ReadS [MailX]
-> ReadPrec MailX
-> ReadPrec [MailX]
-> Read MailX
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MailX
readsPrec :: Int -> ReadS MailX
$creadList :: ReadS [MailX]
readList :: ReadS [MailX]
$creadPrec :: ReadPrec MailX
readPrec :: ReadPrec MailX
$creadListPrec :: ReadPrec [MailX]
readListPrec :: ReadPrec [MailX]
Read, Int -> MailX -> ShowS
[MailX] -> ShowS
MailX -> String
(Int -> MailX -> ShowS)
-> (MailX -> String) -> ([MailX] -> ShowS) -> Show MailX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MailX -> ShowS
showsPrec :: Int -> MailX -> ShowS
$cshow :: MailX -> String
show :: MailX -> String
$cshowList :: [MailX] -> ShowS
showList :: [MailX] -> ShowS
Show)
instance Exec Mail where
alias :: Mail -> String
alias (Mail [(String, String)]
_ String
a) = String
a
start :: Mail -> (String -> IO ()) -> IO ()
start (Mail [(String, String)]
ms String
a) = MailX -> (String -> IO ()) -> IO ()
forall e. Exec e => e -> (String -> IO ()) -> IO ()
start ([(String, String, String)] -> [String] -> String -> MailX
MailX (((String, String) -> (String, String, String))
-> [(String, String)] -> [(String, String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
n,String
p) -> (String
n,String
p,String
"")) [(String, String)]
ms) [] String
a)
instance Exec MailX where
alias :: MailX -> String
alias (MailX [(String, String, String)]
_ [String]
_ String
a) = String
a
#ifndef INOTIFY
start _ _ =
hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
++ " but the Mail plugin requires it."
#else
start :: MailX -> (String -> IO ()) -> IO ()
start (MailX [(String, String, String)]
ms [String]
args String
_) String -> IO ()
cb = do
vs <- ((String, String, String) -> IO (TVar (Set String)))
-> [(String, String, String)] -> IO [TVar (Set String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (IO (TVar (Set String))
-> (String, String, String) -> IO (TVar (Set String))
forall a b. a -> b -> a
const (IO (TVar (Set String))
-> (String, String, String) -> IO (TVar (Set String)))
-> IO (TVar (Set String))
-> (String, String, String)
-> IO (TVar (Set String))
forall a b. (a -> b) -> a -> b
$ Set String -> IO (TVar (Set String))
forall a. a -> IO (TVar a)
newTVarIO Set String
forall a. Set a
S.empty) [(String, String, String)]
ms
opts <- parseOptsWith options defaults args
let prefix = MOptions -> String
oPrefix MOptions
opts
suffix = MOptions -> String
oSuffix MOptions
opts
dir = MOptions -> String
oDir MOptions
opts
ps = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_,String
p,String
_) -> if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
dir then String
p else String
dir String -> ShowS
</> String
p) [(String, String, String)]
ms
rs = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> ShowS
</> String
"new") [String]
ps
ev = [EventVariety
Move, EventVariety
MoveIn, EventVariety
MoveOut, EventVariety
Create, EventVariety
Delete]
ds <- mapM expandHome rs
i <- initINotify
zipWithM_ (\ByteString
d TVar (Set String)
v -> INotify
-> [EventVariety]
-> ByteString
-> (Event -> IO ())
-> IO WatchDescriptor
addWatch INotify
i [EventVariety]
ev ByteString
d (TVar (Set String) -> Event -> IO ()
handle TVar (Set String)
v)) (map pack ds) vs
forM_ (zip ds vs) $ \(String
d, TVar (Set String)
v) -> do
s <- ([String] -> Set String) -> IO [String] -> IO (Set String)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String)
-> ([String] -> [String]) -> [String] -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
"."))
(IO [String] -> IO (Set String)) -> IO [String] -> IO (Set String)
forall a b. (a -> b) -> a -> b
$ String -> IO [String]
getDirectoryContents String
d
atomically $ modifyTVar v (S.union s)
changeLoop (mapM (fmap S.size . readTVar) vs) $ \[Int]
ns ->
let showmbx :: String -> a -> ShowS
showmbx String
m a
n String
c = if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
then String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n
else String
"<fc=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</fc>"
cnts :: [String]
cnts = [String -> Int -> ShowS
forall {a}. Show a => String -> a -> ShowS
showmbx String
m Int
n String
c | ((String
m,String
_,String
c), Int
n) <- [(String, String, String)]
-> [Int] -> [((String, String, String), Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(String, String, String)]
ms [Int]
ns , Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 ]
in String -> IO ()
cb (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cnts then String
"" else String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
unwords [String]
cnts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix
handle :: TVar (Set String) -> Event -> IO ()
handle :: TVar (Set String) -> Event -> IO ()
handle TVar (Set String)
v Event
e = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (Set String) -> (Set String -> Set String) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar TVar (Set String)
v ((Set String -> Set String) -> STM ())
-> (Set String -> Set String) -> STM ()
forall a b. (a -> b) -> a -> b
$ case Event
e of
Created {} -> Set String -> Set String
create
MovedIn {} -> Set String -> Set String
create
Deleted {} -> Set String -> Set String
delete
MovedOut {} -> Set String -> Set String
delete
Event
_ -> Set String -> Set String
forall a. a -> a
id
where
delete :: Set String -> Set String
delete = String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
S.delete ((ByteString -> String
unpack (ByteString -> String) -> (Event -> ByteString) -> Event -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> ByteString
filePath) Event
e)
create :: Set String -> Set String
create = String -> Set String -> Set String
forall a. Ord a => a -> Set a -> Set a
S.insert ((ByteString -> String
unpack (ByteString -> String) -> (Event -> ByteString) -> Event -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> ByteString
filePath) Event
e)
#endif