{-# LANGUAGE CPP #-}
module Xmobar.Plugins.MBox (MBox(..)) where
import Prelude
import Xmobar.Run.Exec
#ifdef INOTIFY
import Xmobar.Plugins.Monitors.Common (parseOptsWith)
import Xmobar.System.Utils (changeLoop, expandHome)
import Control.Monad (when)
import Control.Concurrent.STM
import Control.Exception (SomeException (..), handle, evaluate)
import System.Console.GetOpt
import System.Directory (doesFileExist)
import System.FilePath ((</>))
import System.INotify (Event(..), EventVariety(..), initINotify, addWatch)
import qualified Data.ByteString.Lazy.Char8 as B
#if MIN_VERSION_hinotify(0,3,10)
import qualified Data.ByteString.Char8 as BS (ByteString, pack)
pack :: String -> BS.ByteString
pack :: String -> ByteString
pack = String -> ByteString
BS.pack
#else
pack :: String -> String
pack = id
#endif
data Options = Options
{ Options -> Bool
oAll :: Bool
, Options -> Bool
oUniq :: Bool
, Options -> String
oDir :: FilePath
, Options -> String
oPrefix :: String
, Options -> String
oSuffix :: String
}
defaults :: Options
defaults :: Options
defaults = Options {
oAll :: Bool
oAll = Bool
False, oUniq :: Bool
oUniq = Bool
False, oDir :: String
oDir = String
"", oPrefix :: String
oPrefix = String
"", oSuffix :: String
oSuffix = String
""
}
options :: [OptDescr (Options -> Options)]
options :: [OptDescr (Options -> Options)]
options =
[ String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"a" [String
"all"] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o { oAll :: Bool
oAll = Bool
True })) String
""
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"u" [] ((Options -> Options) -> ArgDescr (Options -> Options)
forall a. a -> ArgDescr a
NoArg (\Options
o -> Options
o { oUniq :: Bool
oUniq = Bool
True })) String
""
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"d" [String
"dir"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x Options
o -> Options
o { oDir :: String
oDir = String
x }) String
"") String
""
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"p" [String
"prefix"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x Options
o -> Options
o { oPrefix :: String
oPrefix = String
x }) String
"") String
""
, String
-> [String]
-> ArgDescr (Options -> Options)
-> String
-> OptDescr (Options -> Options)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"s" [String
"suffix"] ((String -> Options -> Options)
-> String -> ArgDescr (Options -> Options)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x Options
o -> Options
o { oSuffix :: String
oSuffix = String
x }) String
"") String
""
]
#else
import System.IO
#endif
data MBox = MBox [(String, FilePath, String)] [String] String
deriving (ReadPrec [MBox]
ReadPrec MBox
Int -> ReadS MBox
ReadS [MBox]
(Int -> ReadS MBox)
-> ReadS [MBox] -> ReadPrec MBox -> ReadPrec [MBox] -> Read MBox
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS MBox
readsPrec :: Int -> ReadS MBox
$creadList :: ReadS [MBox]
readList :: ReadS [MBox]
$creadPrec :: ReadPrec MBox
readPrec :: ReadPrec MBox
$creadListPrec :: ReadPrec [MBox]
readListPrec :: ReadPrec [MBox]
Read, Int -> MBox -> ShowS
[MBox] -> ShowS
MBox -> String
(Int -> MBox -> ShowS)
-> (MBox -> String) -> ([MBox] -> ShowS) -> Show MBox
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MBox -> ShowS
showsPrec :: Int -> MBox -> ShowS
$cshow :: MBox -> String
show :: MBox -> String
$cshowList :: [MBox] -> ShowS
showList :: [MBox] -> ShowS
Show)
instance Exec MBox where
alias :: MBox -> String
alias (MBox [(String, String, String)]
_ [String]
_ String
a) = String
a
#ifndef INOTIFY
start _ _ =
hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
" but the MBox plugin requires it"
#else
start :: MBox -> (String -> IO ()) -> IO ()
start (MBox [(String, String, String)]
boxes [String]
args String
_) String -> IO ()
cb = do
Options
opts <- [OptDescr (Options -> Options)]
-> Options -> [String] -> IO Options
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (Options -> Options)]
options Options
defaults [String]
args
let showAll :: Bool
showAll = Options -> Bool
oAll Options
opts
prefix :: String
prefix = Options -> String
oPrefix Options
opts
suffix :: String
suffix = Options -> String
oSuffix Options
opts
uniq :: Bool
uniq = Options -> Bool
oUniq Options
opts
names :: [String]
names = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
t, String
_, String
_) -> String
t) [(String, String, String)]
boxes
colors :: [String]
colors = ((String, String, String) -> String)
-> [(String, String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
_, String
_, String
c) -> String
c) [(String, String, String)]
boxes
extractPath :: (a, String, c) -> IO String
extractPath (a
_, String
f, c
_) = String -> IO String
expandHome (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Options -> String
oDir Options
opts String -> ShowS
</> String
f
events :: [EventVariety]
events = [EventVariety
CloseWrite]
INotify
i <- IO INotify
initINotify
[TVar (String, Int)]
vs <- ((String, String, String) -> IO (TVar (String, Int)))
-> [(String, String, String)] -> IO [TVar (String, Int)]
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 (\(String, String, String)
b -> do
String
f <- (String, String, String) -> IO String
forall {a} {c}. (a, String, c) -> IO String
extractPath (String, String, String)
b
Bool
exists <- String -> IO Bool
doesFileExist String
f
Int
n <- if Bool
exists then String -> IO Int
countMails String
f else Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (-Int
1)
TVar (String, Int)
v <- (String, Int) -> IO (TVar (String, Int))
forall a. a -> IO (TVar a)
newTVarIO (String
f, Int
n)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
INotify
-> [EventVariety]
-> ByteString
-> (Event -> IO ())
-> IO WatchDescriptor
addWatch INotify
i [EventVariety]
events (String -> ByteString
pack String
f) (TVar (String, Int) -> Event -> IO ()
handleNotification TVar (String, Int)
v) IO WatchDescriptor -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
TVar (String, Int) -> IO (TVar (String, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TVar (String, Int)
v)
[(String, String, String)]
boxes
STM [Int] -> ([Int] -> IO ()) -> IO ()
forall a. Eq a => STM a -> (a -> IO ()) -> IO ()
changeLoop ((TVar (String, Int) -> STM Int)
-> [TVar (String, Int)] -> STM [Int]
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 (((String, Int) -> Int) -> STM (String, Int) -> STM Int
forall a b. (a -> b) -> STM a -> STM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, Int) -> Int
forall a b. (a, b) -> b
snd (STM (String, Int) -> STM Int)
-> (TVar (String, Int) -> STM (String, Int))
-> TVar (String, Int)
-> STM Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TVar (String, Int) -> STM (String, Int)
forall a. TVar a -> STM a
readTVar) [TVar (String, Int)]
vs) (([Int] -> IO ()) -> IO ()) -> ([Int] -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \[Int]
ns ->
let s :: String
s = [String] -> String
unwords [ Bool -> String -> Int -> ShowS
showC Bool
uniq String
m Int
n String
c | (String
m, Int
n, String
c) <- [String] -> [Int] -> [String] -> [(String, Int, String)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [String]
names [Int]
ns [String]
colors
, Bool
showAll Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ]
in String -> IO ()
cb (if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then String
"" else String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
suffix)
showC :: Bool -> String -> Int -> String -> String
showC :: Bool -> String -> Int -> ShowS
showC Bool
u String
m Int
n String
c =
if String
c String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"" then String
msg 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
msg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</fc>"
where msg :: String
msg = String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ if Bool -> Bool
not Bool
u Bool -> Bool -> Bool
|| Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 then Int -> String
forall a. Show a => a -> String
show Int
n else String
""
countMails :: FilePath -> IO Int
countMails :: String -> IO Int
countMails String
f =
(SomeException -> IO Int) -> IO Int -> IO Int
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> Int -> IO Int
forall a. a -> IO a
evaluate Int
0)
(do ByteString
txt <- String -> IO ByteString
B.readFile String
f
Int -> IO Int
forall a. a -> IO a
evaluate (Int -> IO Int) -> Int -> IO Int
forall a b. (a -> b) -> a -> b
$! [ByteString] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([ByteString] -> Int)
-> (ByteString -> [ByteString]) -> ByteString -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
B.isPrefixOf ByteString
from) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
B.lines (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ ByteString
txt)
where from :: ByteString
from = String -> ByteString
B.pack String
"From "
handleNotification :: TVar (FilePath, Int) -> Event -> IO ()
handleNotification :: TVar (String, Int) -> Event -> IO ()
handleNotification TVar (String, Int)
v Event
_ = do
(String
p, Int
_) <- STM (String, Int) -> IO (String, Int)
forall a. STM a -> IO a
atomically (STM (String, Int) -> IO (String, Int))
-> STM (String, Int) -> IO (String, Int)
forall a b. (a -> b) -> a -> b
$ TVar (String, Int) -> STM (String, Int)
forall a. TVar a -> STM a
readTVar TVar (String, Int)
v
Int
n <- String -> IO Int
countMails String
p
STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar (String, Int) -> (String, Int) -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar (String, Int)
v (String
p, Int
n)
#endif