-----------------------------------------------------------------------------
---- |
---- Module      :  Plugins.Monitors.Birght
---- Copyright   :  (c) Martin Perner
---- License     :  BSD-style (see LICENSE)
----
---- Maintainer  :  Martin Perner <martin@perner.cc>
---- Stability   :  unstable
---- Portability :  unportable
----
----  A screen brightness monitor for Xmobar
----
-------------------------------------------------------------------------------

module Xmobar.Plugins.Monitors.Bright (brightConfig, runBright) where

import Control.Exception (SomeException, handle)
import qualified Data.ByteString.Lazy.Char8 as B
import System.FilePath ((</>))
import System.Posix.Files (fileExist)
import System.Console.GetOpt

import Xmobar.Plugins.Monitors.Common

data BrightOpts = BrightOpts { BrightOpts -> String
subDir :: String
                             , BrightOpts -> String
currBright :: String
                             , BrightOpts -> String
maxBright :: String
                             , BrightOpts -> Maybe IconPattern
curBrightIconPattern :: Maybe IconPattern
                             }

defaultOpts :: BrightOpts
defaultOpts :: BrightOpts
defaultOpts = BrightOpts :: String -> String -> String -> Maybe IconPattern -> BrightOpts
BrightOpts { subDir :: String
subDir = String
"acpi_video0"
                         , currBright :: String
currBright = String
"actual_brightness"
                         , maxBright :: String
maxBright = String
"max_brightness"
                         , curBrightIconPattern :: Maybe IconPattern
curBrightIconPattern = Maybe IconPattern
forall a. Maybe a
Nothing
                         }

options :: [OptDescr (BrightOpts -> BrightOpts)]
options :: [OptDescr (BrightOpts -> BrightOpts)]
options = [ String
-> [String]
-> ArgDescr (BrightOpts -> BrightOpts)
-> String
-> OptDescr (BrightOpts -> BrightOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"D" [String
"device"] ((String -> BrightOpts -> BrightOpts)
-> String -> ArgDescr (BrightOpts -> BrightOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BrightOpts
o -> BrightOpts
o { subDir :: String
subDir = String
x }) String
"") String
""
          , String
-> [String]
-> ArgDescr (BrightOpts -> BrightOpts)
-> String
-> OptDescr (BrightOpts -> BrightOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"C" [String
"curr"] ((String -> BrightOpts -> BrightOpts)
-> String -> ArgDescr (BrightOpts -> BrightOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BrightOpts
o -> BrightOpts
o { currBright :: String
currBright = String
x }) String
"") String
""
          , String
-> [String]
-> ArgDescr (BrightOpts -> BrightOpts)
-> String
-> OptDescr (BrightOpts -> BrightOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"M" [String
"max"] ((String -> BrightOpts -> BrightOpts)
-> String -> ArgDescr (BrightOpts -> BrightOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BrightOpts
o -> BrightOpts
o { maxBright :: String
maxBright = String
x }) String
"") String
""
          , String
-> [String]
-> ArgDescr (BrightOpts -> BrightOpts)
-> String
-> OptDescr (BrightOpts -> BrightOpts)
forall a. String -> [String] -> ArgDescr a -> String -> OptDescr a
Option String
"" [String
"brightness-icon-pattern"] ((String -> BrightOpts -> BrightOpts)
-> String -> ArgDescr (BrightOpts -> BrightOpts)
forall a. (String -> a) -> String -> ArgDescr a
ReqArg (\String
x BrightOpts
o ->
             BrightOpts
o { curBrightIconPattern :: Maybe IconPattern
curBrightIconPattern = IconPattern -> Maybe IconPattern
forall a. a -> Maybe a
Just (IconPattern -> Maybe IconPattern)
-> IconPattern -> Maybe IconPattern
forall a b. (a -> b) -> a -> b
$ String -> IconPattern
parseIconPattern String
x }) String
"") String
""
          ]

sysDir :: FilePath
sysDir :: String
sysDir = String
"/sys/class/backlight/"

brightConfig :: IO MConfig
brightConfig :: IO MConfig
brightConfig = String -> [String] -> IO MConfig
mkMConfig String
"<percent>" -- template
                         [String
"vbar", String
"percent", String
"bar", String
"ipat"] -- replacements

data Files = Files { Files -> String
fCurr :: String
                   , Files -> String
fMax :: String
                   }
           | NoFiles

brightFiles :: BrightOpts -> IO Files
brightFiles :: BrightOpts -> IO Files
brightFiles BrightOpts
opts = do
  Bool
is_curr <- String -> IO Bool
fileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ Files -> String
fCurr Files
files
  Bool
is_max  <- String -> IO Bool
fileExist (String -> IO Bool) -> String -> IO Bool
forall a b. (a -> b) -> a -> b
$ Files -> String
fCurr Files
files
  Files -> IO Files
forall (m :: * -> *) a. Monad m => a -> m a
return (if Bool
is_curr Bool -> Bool -> Bool
&& Bool
is_max then Files
files else Files
NoFiles)
  where prefix :: String
prefix = String
sysDir String -> String -> String
</> BrightOpts -> String
subDir BrightOpts
opts
        files :: Files
files = Files :: String -> String -> Files
Files { fCurr :: String
fCurr = String
prefix String -> String -> String
</> BrightOpts -> String
currBright BrightOpts
opts
                      , fMax :: String
fMax = String
prefix String -> String -> String
</> BrightOpts -> String
maxBright BrightOpts
opts
                      }

runBright :: [String] ->  Monitor String
runBright :: [String] -> Monitor String
runBright [String]
args = do
  BrightOpts
opts <- IO BrightOpts -> Monitor BrightOpts
forall a. IO a -> Monitor a
io (IO BrightOpts -> Monitor BrightOpts)
-> IO BrightOpts -> Monitor BrightOpts
forall a b. (a -> b) -> a -> b
$ [OptDescr (BrightOpts -> BrightOpts)]
-> BrightOpts -> [String] -> IO BrightOpts
forall opts.
[OptDescr (opts -> opts)] -> opts -> [String] -> IO opts
parseOptsWith [OptDescr (BrightOpts -> BrightOpts)]
options BrightOpts
defaultOpts [String]
args
  Files
f <- IO Files -> Monitor Files
forall a. IO a -> Monitor a
io (IO Files -> Monitor Files) -> IO Files -> Monitor Files
forall a b. (a -> b) -> a -> b
$ BrightOpts -> IO Files
brightFiles BrightOpts
opts
  Float
c <- IO Float -> Monitor Float
forall a. IO a -> Monitor a
io (IO Float -> Monitor Float) -> IO Float -> Monitor Float
forall a b. (a -> b) -> a -> b
$ Files -> IO Float
readBright Files
f
  case Files
f of
    Files
NoFiles -> String -> Monitor String
forall (m :: * -> *) a. Monad m => a -> m a
return String
"hurz"
    Files
_ -> BrightOpts -> Float -> Monitor [String]
fmtPercent BrightOpts
opts Float
c Monitor [String] -> ([String] -> Monitor String) -> Monitor String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> Monitor String
parseTemplate
  where fmtPercent :: BrightOpts -> Float -> Monitor [String]
        fmtPercent :: BrightOpts -> Float -> Monitor [String]
fmtPercent BrightOpts
opts Float
c = do String
r <- Float -> Float -> Monitor String
showVerticalBar (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c) Float
c
                               String
s <- Float -> Monitor String
showPercentWithColors Float
c
                               String
t <- Float -> Float -> Monitor String
showPercentBar (Float
100 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
c) Float
c
                               String
d <- Maybe IconPattern -> Float -> Monitor String
showIconPattern (BrightOpts -> Maybe IconPattern
curBrightIconPattern BrightOpts
opts) Float
c
                               [String] -> Monitor [String]
forall (m :: * -> *) a. Monad m => a -> m a
return [String
r,String
s,String
t,String
d]

readBright :: Files -> IO Float
readBright :: Files -> IO Float
readBright Files
NoFiles = Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0
readBright Files
files = do
  Float
currVal<- String -> IO Float
grab (String -> IO Float) -> String -> IO Float
forall a b. (a -> b) -> a -> b
$ Files -> String
fCurr Files
files
  Float
maxVal <- String -> IO Float
grab (String -> IO Float) -> String -> IO Float
forall a b. (a -> b) -> a -> b
$ Files -> String
fMax Files
files
  Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return (Float
currVal Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxVal)
  where grab :: String -> IO Float
grab String
f = (SomeException -> IO Float) -> IO Float -> IO Float
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO Float
handler (String -> Float
forall a. Read a => String -> a
read (String -> Float) -> (ByteString -> String) -> ByteString -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
B.unpack (ByteString -> Float) -> IO ByteString -> IO Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
B.readFile String
f)
        handler :: SomeException -> IO Float
handler = IO Float -> SomeException -> IO Float
forall a b. a -> b -> a
const (Float -> IO Float
forall (m :: * -> *) a. Monad m => a -> m a
return Float
0) :: SomeException -> IO Float