1{-# LANGUAGE CPP #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Plugins.Mail
5-- Copyright   :  (c) Spencer Janssen
6-- License     :  BSD-style (see LICENSE)
7--
8-- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
9-- Stability   :  unstable
10-- Portability :  unportable
11--
12-- A plugin for checking mail.
13--
14-----------------------------------------------------------------------------
15
16module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where
17
18import Xmobar.Run.Exec
19#ifdef INOTIFY
20
21import Xmobar.Plugins.Monitors.Common (parseOptsWith)
22import Xmobar.System.Utils (expandHome, changeLoop)
23
24import Control.Monad
25import Control.Concurrent.STM
26
27import System.Directory
28import System.FilePath
29import System.INotify
30import System.Console.GetOpt
31
32import Data.List (isPrefixOf)
33import Data.Set (Set)
34import qualified Data.Set as S
35
36#if MIN_VERSION_hinotify(0,3,10)
37import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack)
38unpack :: BS.ByteString -> String
39unpack = BS.unpack
40pack :: String -> BS.ByteString
41pack = BS.pack
42#else
43unpack :: String -> String
44unpack = id
45pack :: String -> String
46pack = id
47#endif
48#else
49import System.IO
50#endif
51
52data MOptions = MOptions
53               { oDir :: FilePath
54               , oPrefix :: String
55               , oSuffix :: String
56               }
57
58defaults :: MOptions
59defaults = MOptions {oDir = "", oPrefix = "", oSuffix = ""}
60
61options :: [OptDescr (MOptions -> MOptions)]
62options =
63  [ Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
64  , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
65  , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
66  ]
67
68-- | A list of mail box names and paths to maildirs.
69data Mail = Mail [(String, FilePath)] String
70    deriving (Read, Show)
71
72-- | A list of mail box names, paths to maildirs and display colors.
73data MailX = MailX [(String, FilePath, String)] [String] String
74    deriving (Read, Show)
75
76instance Exec Mail where
77  alias (Mail _ a) = a
78  start (Mail ms a) = start (MailX (map (\(n,p) -> (n,p,"")) ms) [] a)
79
80instance Exec MailX where
81    alias (MailX _ _ a) = a
82#ifndef INOTIFY
83    start _ _ =
84        hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify,"
85                        ++ " but the Mail plugin requires it."
86#else
87    start (MailX ms args _) cb = do
88        vs <- mapM (const $ newTVarIO S.empty) ms
89        opts <- parseOptsWith options defaults args
90        let prefix = oPrefix opts
91            suffix = oSuffix opts
92            dir = oDir opts
93            ps = map (\(_,p,_) -> if null dir then p else dir </> p) ms
94            rs = map (</> "new") ps
95            ev = [Move, MoveIn, MoveOut, Create, Delete]
96
97        ds <- mapM expandHome rs
98        i <- initINotify
99        zipWithM_ (\d v -> addWatch i ev d (handle v)) (map pack ds) vs
100
101        forM_ (zip ds vs) $ \(d, v) -> do
102            s <- fmap (S.fromList . filter (not . isPrefixOf "."))
103                    $ getDirectoryContents d
104            atomically $ modifyTVar v (S.union s)
105
106        changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns ->
107            let showmbx m n c = if c == ""
108                                then m ++ show n
109                                else "<fc=" ++ c ++ ">" ++ m ++ show n ++ "</fc>"
110                cnts = [showmbx m n c | ((m,_,c), n) <- zip ms ns , n /= 0 ]
111            in cb $ if null cnts then "" else prefix ++ unwords cnts ++ suffix
112
113handle :: TVar (Set String) -> Event -> IO ()
114handle v e = atomically $ modifyTVar v $ case e of
115    Created  {} -> create
116    MovedIn  {} -> create
117    Deleted  {} -> delete
118    MovedOut {} -> delete
119    _           -> id
120 where
121    delete = S.delete ((unpack . filePath) e)
122    create = S.insert ((unpack . filePath) e)
123#endif
124