File: MBox.hs

package info (click to toggle)
xmobar 0.29.4-2
  • links: PTS, VCS
  • area: main
  • in suites: buster
  • size: 1,260 kB
  • sloc: haskell: 5,669; sh: 96; makefile: 49
file content (132 lines) | stat: -rw-r--r-- 4,125 bytes parent folder | download
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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- 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 Xmobar.Plugins.MBox (MBox(..)) where

import Prelude
import Xmobar.Run.Exec
#ifdef INOTIFY

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 = BS.pack
#else
pack :: String -> String
pack = id
#endif

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

#else
import System.IO
#endif

-- | 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
#ifndef INOTIFY
  start _ _ =
    hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++
          " but the MBox plugin requires it"
#else
  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 (pack 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 (\(SomeException _) -> evaluate 0)
         (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)
#endif