1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
|
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.MBox
-- Copyright : (c) Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
-- Stability : unstable
-- Portability : unportable
--
-- A plugin for checking mail in mbox files.
--
-----------------------------------------------------------------------------
module Plugins.MBox (MBox(..)) where
import Prelude hiding (catch)
import Plugins
import Plugins.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
data Options = Options
{ oAll :: Bool
, oUniq :: Bool
, oDir :: FilePath
, oPrefix :: String
, oSuffix :: String
}
defaults :: Options
defaults = Options {
oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = ""
}
options :: [OptDescr (Options -> Options)]
options =
[ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) ""
, Option "u" [] (NoArg (\o -> o { oUniq = True })) ""
, Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") ""
, Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") ""
, Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") ""
]
parseOptions :: [String] -> IO Options
parseOptions args =
case getOpt Permute options args of
(o, _, []) -> return $ foldr id defaults o
(_, _, errs) -> ioError . userError $ concat errs
-- | A list of display names, paths to mbox files and display colours,
-- followed by a list of options.
data MBox = MBox [(String, FilePath, String)] [String] String
deriving (Read, Show)
instance Exec MBox where
alias (MBox _ _ a) = a
start (MBox boxes args _) cb = do
opts <- parseOptions args
let showAll = oAll opts
prefix = oPrefix opts
suffix = oSuffix opts
uniq = oUniq opts
names = map (\(t, _, _) -> t) boxes
colors = map (\(_, _, c) -> c) boxes
extractPath (_, f, _) = expandHome $ oDir opts </> f
events = [CloseWrite]
i <- initINotify
vs <- mapM (\b -> do
f <- extractPath b
exists <- doesFileExist f
n <- if exists then countMails f else return (-1)
v <- newTVarIO (f, n)
when exists $
addWatch i events f (handleNotification v) >> return ()
return v)
boxes
changeLoop (mapM (fmap snd . readTVar) vs) $ \ns ->
let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors
, showAll || n > 0 ]
in cb (if null s then "" else prefix ++ s ++ suffix)
showC :: Bool -> String -> Int -> String -> String
showC u m n c =
if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>"
where msg = m ++ if not u || n > 1 then show n else ""
countMails :: FilePath -> IO Int
countMails f =
handle ((\_ -> evaluate 0) :: SomeException -> IO Int)
(do txt <- B.readFile f
evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt)
where from = B.pack "From "
handleNotification :: TVar (FilePath, Int) -> Event -> IO ()
handleNotification v _ = do
(p, _) <- atomically $ readTVar v
n <- countMails p
atomically $ writeTVar v (p, n)
|
