module XMonad.Util.Loggers (
Logger
, aumixVolume
, battery
, date
, loadAvg
, maildirNew, maildirUnread
, logCmd , logFileCount
, logCurrent, logLayout, logTitle
, onLogger
, wrapL, fixedWidthL
, logSp, padL
, shortenL
, dzenColorL, xmobarColorL
, (<$>)
) where
import XMonad (liftIO)
import XMonad.Core
import qualified XMonad.StackSet as W
import XMonad.Hooks.DynamicLog
import XMonad.Util.Font (Align (..))
import XMonad.Util.NamedWindows (getName)
import Control.Applicative ((<$>))
import Control.Exception as E
import Data.List (isPrefixOf, isSuffixOf)
import Data.Maybe (fromMaybe)
import Data.Traversable (traverse)
import System.Directory (getDirectoryContents)
import System.IO
import System.Locale
import System.Process (runInteractiveCommand)
import System.Time
econst :: Monad m => a -> IOException -> m a
econst :: a -> IOException -> m a
econst = m a -> IOException -> m a
forall a b. a -> b -> a
const (m a -> IOException -> m a)
-> (a -> m a) -> a -> IOException -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
type Logger = X (Maybe String)
aumixVolume :: Logger
aumixVolume :: Logger
aumixVolume = String -> Logger
logCmd String
"aumix -vq"
battery :: Logger
battery :: Logger
battery = String -> Logger
logCmd String
"/usr/bin/acpi | sed -r 's/.*?: (.*%).*/\\1/; s/[dD]ischarging, ([0-9]+%)/\\1-/; s/[cC]harging, ([0-9]+%)/\\1+/; s/[cC]harged, //'"
date :: String -> Logger
date :: String -> Logger
date String
fmt = IO (Maybe String) -> Logger
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe String) -> Logger) -> IO (Maybe String) -> Logger
forall a b. (a -> b) -> a -> b
$ do CalendarTime
cal <- (IO ClockTime
getClockTime IO ClockTime -> (ClockTime -> IO CalendarTime) -> IO CalendarTime
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ClockTime -> IO CalendarTime
toCalendarTime)
Maybe String -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> IO (Maybe String))
-> (String -> Maybe String) -> String -> IO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> IO (Maybe String)) -> String -> IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ TimeLocale -> String -> CalendarTime -> String
formatCalendarTime TimeLocale
defaultTimeLocale String
fmt CalendarTime
cal
loadAvg :: Logger
loadAvg :: Logger
loadAvg = String -> Logger
logCmd String
"/usr/bin/uptime | sed 's/.*: //; s/,//g'"
logCmd :: String -> Logger
logCmd :: String -> Logger
logCmd String
c = IO (Maybe String) -> Logger
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO (Maybe String) -> Logger) -> IO (Maybe String) -> Logger
forall a b. (a -> b) -> a -> b
$ do (Handle
_, Handle
out, Handle
_, ProcessHandle
_) <- String -> IO (Handle, Handle, Handle, ProcessHandle)
runInteractiveCommand String
c
(String -> Maybe String) -> IO String -> IO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Maybe String
forall a. a -> Maybe a
Just (Handle -> IO String
hGetLine Handle
out) IO (Maybe String)
-> (IOException -> IO (Maybe String)) -> IO (Maybe String)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` Maybe String -> IOException -> IO (Maybe String)
forall (m :: * -> *) a. Monad m => a -> IOException -> m a
econst Maybe String
forall a. Maybe a
Nothing
logFileCount :: FilePath
-> (String -> Bool)
-> Logger
logFileCount :: String -> (String -> Bool) -> Logger
logFileCount String
d String -> Bool
p = do
[String]
c <- IO [String] -> X [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO ( String -> IO [String]
getDirectoryContents String
d)
let n :: Int
n = [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([String] -> Int) -> [String] -> Int
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
Prelude.filter String -> Bool
p [String]
c
case Int
n of
Int
0 -> Maybe String -> Logger
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe String
forall a. Maybe a
Nothing
Int
_ -> Maybe String -> Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Logger) -> Maybe String -> Logger
forall a b. (a -> b) -> a -> b
$ String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
n
maildirUnread :: FilePath -> Logger
maildirUnread :: String -> Logger
maildirUnread String
mdir = String -> (String -> Bool) -> Logger
logFileCount (String
mdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/cur/") (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf String
",")
maildirNew :: FilePath -> Logger
maildirNew :: String -> Logger
maildirNew String
mdir = String -> (String -> Bool) -> Logger
logFileCount (String
mdir String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/new/") (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf String
".")
logTitle :: Logger
logTitle :: Logger
logTitle = (WindowSet -> Logger) -> Logger
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> Logger) -> Logger)
-> (WindowSet -> Logger) -> Logger
forall a b. (a -> b) -> a -> b
$ (Window -> X String) -> Maybe Window -> Logger
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((NamedWindow -> String) -> X NamedWindow -> X String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap NamedWindow -> String
forall a. Show a => a -> String
show (X NamedWindow -> X String)
-> (Window -> X NamedWindow) -> Window -> X String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window -> X NamedWindow
getName) (Maybe Window -> Logger)
-> (WindowSet -> Maybe Window) -> WindowSet -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> Maybe Window
forall i l a s sd. StackSet i l a s sd -> Maybe a
W.peek
logLayout :: Logger
logLayout :: Logger
logLayout = (WindowSet -> Logger) -> Logger
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> Logger) -> Logger)
-> (WindowSet -> Logger) -> Logger
forall a b. (a -> b) -> a -> b
$ Maybe String -> Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Logger)
-> (WindowSet -> Maybe String) -> WindowSet -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (WindowSet -> String) -> WindowSet -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> String
forall i a sid sd. StackSet i (Layout Window) a sid sd -> String
ld
where ld :: StackSet i (Layout Window) a sid sd -> String
ld = Layout Window -> String
forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description (Layout Window -> String)
-> (StackSet i (Layout Window) a sid sd -> Layout Window)
-> StackSet i (Layout Window) a sid sd
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Workspace i (Layout Window) a -> Layout Window
forall i l a. Workspace i l a -> l
W.layout (Workspace i (Layout Window) a -> Layout Window)
-> (StackSet i (Layout Window) a sid sd
-> Workspace i (Layout Window) a)
-> StackSet i (Layout Window) a sid sd
-> Layout Window
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Screen i (Layout Window) a sid sd -> Workspace i (Layout Window) a
forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace (Screen i (Layout Window) a sid sd
-> Workspace i (Layout Window) a)
-> (StackSet i (Layout Window) a sid sd
-> Screen i (Layout Window) a sid sd)
-> StackSet i (Layout Window) a sid sd
-> Workspace i (Layout Window) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StackSet i (Layout Window) a sid sd
-> Screen i (Layout Window) a sid sd
forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current
logCurrent :: Logger
logCurrent :: Logger
logCurrent = (WindowSet -> Logger) -> Logger
forall a. (WindowSet -> X a) -> X a
withWindowSet ((WindowSet -> Logger) -> Logger)
-> (WindowSet -> Logger) -> Logger
forall a b. (a -> b) -> a -> b
$ Maybe String -> Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Logger)
-> (WindowSet -> Maybe String) -> WindowSet -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (WindowSet -> String) -> WindowSet -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WindowSet -> String
forall i l a s sd. StackSet i l a s sd -> i
W.currentTag
onLogger :: (String -> String) -> Logger -> Logger
onLogger :: (String -> String) -> Logger -> Logger
onLogger = (Maybe String -> Maybe String) -> Logger -> Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe String -> Maybe String) -> Logger -> Logger)
-> ((String -> String) -> Maybe String -> Maybe String)
-> (String -> String)
-> Logger
-> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> Maybe String -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
wrapL :: String -> String -> Logger -> Logger
wrapL :: String -> String -> Logger -> Logger
wrapL String
l String
r = (String -> String) -> Logger -> Logger
onLogger ((String -> String) -> Logger -> Logger)
-> (String -> String) -> Logger -> Logger
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
wrap String
l String
r
fixedWidthL :: Align
-> String
-> Int
-> Logger -> Logger
fixedWidthL :: Align -> String -> Int -> Logger -> Logger
fixedWidthL Align
a String
str Int
n Logger
logger = do
Maybe String
mbl <- Logger
logger
let l :: String
l = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" Maybe String
mbl
case Align
a of
Align
AlignCenter -> String -> Logger
forall a. a -> X (Maybe a)
toL (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall (t :: * -> *) a. Foldable t => t a -> String
padhalf String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
Align
AlignRight -> String -> Logger
forall a. a -> X (Maybe a)
toL (String -> String
forall a. [a] -> [a]
reverse (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs))
Align
_ -> String -> Logger
forall a. a -> X (Maybe a)
toL (Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cs)
where
toL :: a -> X (Maybe a)
toL = Maybe a -> X (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> X (Maybe a)) -> (a -> Maybe a) -> a -> X (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe a
forall a. a -> Maybe a
Just
cs :: String
cs = String -> String
forall a. [a] -> [a]
cycle String
str
padhalf :: t a -> String
padhalf t a
x = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
take ((Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
x) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2) String
cs
logSp :: Int -> Logger
logSp :: Int -> Logger
logSp Int
n = Maybe String -> Logger
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe String -> Logger)
-> (String -> Maybe String) -> String -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (String -> String) -> String -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
n (String -> Logger) -> String -> Logger
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
cycle String
" "
padL :: Logger -> Logger
padL :: Logger -> Logger
padL = (String -> String) -> Logger -> Logger
onLogger String -> String
pad
shortenL :: Int -> Logger -> Logger
shortenL :: Int -> Logger -> Logger
shortenL = (String -> String) -> Logger -> Logger
onLogger ((String -> String) -> Logger -> Logger)
-> (Int -> String -> String) -> Int -> Logger -> Logger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> String
shorten
dzenColorL :: String -> String -> Logger -> Logger
dzenColorL :: String -> String -> Logger -> Logger
dzenColorL String
fg String
bg = (String -> String) -> Logger -> Logger
onLogger ((String -> String) -> Logger -> Logger)
-> (String -> String) -> Logger -> Logger
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
dzenColor String
fg String
bg
xmobarColorL :: String -> String -> Logger -> Logger
xmobarColorL :: String -> String -> Logger -> Logger
xmobarColorL String
fg String
bg = (String -> String) -> Logger -> Logger
onLogger ((String -> String) -> Logger -> Logger)
-> (String -> String) -> Logger -> Logger
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String
xmobarColor String
fg String
bg