{-# 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.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 = 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 = 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 = 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 = 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 = x }) String
"") String
""
  ]

#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 (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
    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 = Options -> Bool
oAll Options
opts
        prefix = Options -> String
oPrefix Options
opts
        suffix = Options -> String
oSuffix Options
opts
        uniq = Options -> Bool
oUniq Options
opts
        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, 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
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
CloseWrite]

    i <- initINotify
    vs <- mapM (\(String, String, String)
b -> do
                   f <- (String, String, String) -> IO String
forall {a} {c}. (a, String, c) -> IO String
extractPath (String, String, String)
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) $ \[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 txt <- String -> IO ByteString
B.readFile String
f
             evaluate $! length . filter (B.isPrefixOf from) . B.lines $ 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
  (p, _) <- 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
  n <- countMails p
  atomically $ writeTVar v (p, n)
#endif