{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP#-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.Brightness
-- License     :  MIT
--
-- Stability   :  unstable
-- Portability :  unportable
--
-- Module to control the brightness of the screen in linux environments
--
-- [@Requirements@]
--     This module assumes that the following files exists:
--
--     * __\/sys\/class\/backlight\/intel_backlight\/max_brightness__
--
--     * __\/sys\/class\/backlight\/intel_backlight\/brightness__
--
--     Also, brightness should be updatable by changing the content of
--     __\/sys\/class\/backlight\/intel_backlight\/brightness__.
--
-- [@Permissions@]
--     To use this module, the owner of the __xmonad__ process will need to
--     have permission to write to __\/sys\/class\/backlight\/intel_backlight\/brightness__.
--     To achieve this, you can:
--
--     * Create a group with your user and root and give permissions to this
--     group to write to the file. I usually follow these steps:
--         
--         * Create a group named xmonad
--
--         > $ sudo groupadd xmonad
--
--         * Add user root and your user name to the group xmonad.
--
--         > $ sudo usermod -a -G xmonad root
--         > $ sudo usermod -a -G xmonad sibi
--
--         * The files under __\/sys__ are virtual. It's a RAM based filesystem through which you can access kernel data structures. The permission you give there won't persist after reboot. One of the way for persisting is creating a <https://unix.stackexchange.com/a/409780/29539 systemd script>:
--
--         > $ cat /etc/systemd/system/brightness.service
--         > [Unit]
--         > Description=Set brightness writable to everybody
--         > Before=nodered.service
--         > 
--         > [Service]
--         > Type=oneshot
--         > User=root
--         > ExecStart=/bin/bash -c "chgrp -R -H xmonad /sys/class/backlight/intel_backlight && chmod g+w /sys/class/backlight/intel_backlight/brightness"
--         > 
--         > [Install]
--         > WantedBy=multi-user.target
--         >
--         > $ sudo systemctl enable brightness.service
--         > $ sudo systemctl start brightness.service
--         > $ sudo systemctl status brightness.service
--
--
--     * Allow anyone to write the file through 646 permissions: __-rw-r--rw-__;
-- 
-----------------------------------------------------------------------------
module XMonad.Util.Brightness
    ( increase
    , decrease
    , change
    , setBrightness
    ) where

import XMonad
#if (MIN_VERSION_base(4,10,0))
import Data.Traversable (traverse)
#endif
import Prelude
import System.IO (hPutStrLn, stderr)
import Control.Monad (join)
import Data.Bifunctor (first)
import Control.Exception (try)
import Control.Applicative (liftA2)
import Data.ByteString.Char8 (unpack)
import qualified Data.ByteString as BS

maxfile :: FilePath
maxfile :: String
maxfile = String
"/sys/class/backlight/intel_backlight/max_brightness"

currentfile :: FilePath
currentfile :: String
currentfile = String
"/sys/class/backlight/intel_backlight/brightness"

-- | Update brightness by +100
increase :: X ()
increase :: X ()
increase = IO () -> X ()
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> IO (Either () ())
change (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
100) IO (Either () ()) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Update brightness by -100
decrease :: X ()
decrease :: X ()
decrease = IO () -> X ()
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> IO (Either () ())
change (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (-Int
100)) IO (Either () ()) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (() -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Change brightness to a particular level
--
-- @since 0.13.4
setBrightness :: Int -> X ()
setBrightness :: Int -> X ()
setBrightness Int
level = IO () -> X ()
forall a. IO a -> X a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> X ()) -> IO () -> X ()
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> IO (Either () ())
change (\Int
_ -> Int
level) IO (Either () ()) -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Perform all needed IO to update screen brightness
change :: (Int -> Int) -> IO (Either () ())
change :: (Int -> Int) -> IO (Either () ())
change Int -> Int
f = do
  Either String Int
maxBright <- String
-> (ByteString -> Either String Int) -> IO (Either String Int)
forall a.
String -> (ByteString -> Either String a) -> IO (Either String a)
getFromFile String
maxfile ByteString -> Either String Int
readInt
  Either String Int
current <- String
-> (ByteString -> Either String Int) -> IO (Either String Int)
forall a.
String -> (ByteString -> Either String a) -> IO (Either String a)
getFromFile String
currentfile ByteString -> Either String Int
readInt
  Either String () -> IO (Either () ())
forall e. Either String e -> IO (Either () e)
printError (Either String () -> IO (Either () ()))
-> IO (Either String ()) -> IO (Either () ())
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Int -> IO (Either String ()))
-> Either String Int -> IO (Either String ())
apply (String -> Int -> IO (Either String ())
writeToFile String
currentfile) ((Int -> Int -> Int)
-> Either String Int -> Either String Int -> Either String Int
forall a b c.
(a -> b -> c)
-> Either String a -> Either String b -> Either String c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((Int -> Int) -> Int -> Int -> Int
guard Int -> Int
f) Either String Int
maxBright Either String Int
current)

apply :: (Int -> IO (Either String ())) -> Either String Int -> IO (Either String ())
apply :: (Int -> IO (Either String ()))
-> Either String Int -> IO (Either String ())
apply Int -> IO (Either String ())
f = (Either String (Either String ()) -> Either String ())
-> IO (Either String (Either String ())) -> IO (Either String ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Either String (Either String ()) -> Either String ()
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Either String (Either String ())) -> IO (Either String ()))
-> (Either String Int -> IO (Either String (Either String ())))
-> Either String Int
-> IO (Either String ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> IO (Either String ()))
-> Either String Int -> IO (Either String (Either String ()))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Either String a -> f (Either String b)
traverse Int -> IO (Either String ())
f

guard :: (Int -> Int) -> Int -> Int -> Int
guard :: (Int -> Int) -> Int -> Int -> Int
guard Int -> Int
f Int
limit Int
current
  | Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
limit = Int
limit
  | Int
value Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = Int
0
  | Bool
otherwise = Int
value
  where value :: Int
value = Int -> Int
f Int
current

readInt :: BS.ByteString -> Either String Int
readInt :: ByteString -> Either String Int
readInt ByteString
str = case (ReadS Int
forall a. Read a => ReadS a
reads (ByteString -> String
unpack ByteString
str)) of
                [(Int
n, String
"\n")] -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
n
                [(Int
n, String
"")]   -> Int -> Either String Int
forall a b. b -> Either a b
Right Int
n
                [(Int, String)]
_           -> String -> Either String Int
forall a b. a -> Either a b
Left String
"Could not parse string to int"

printError :: Either String e -> IO (Either () e)
printError :: forall e. Either String e -> IO (Either () e)
printError Either String e
es = (String -> IO (Either () e))
-> (e -> IO (Either () e)) -> Either String e -> IO (Either () e)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\String
str -> Handle -> String -> IO ()
hPutStrLn Handle
stderr String
str IO () -> IO (Either () e) -> IO (Either () e)
forall a b. IO a -> IO b -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Either () e -> IO (Either () e)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either () e -> IO (Either () e))
-> (() -> Either () e) -> () -> IO (Either () e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either () e
forall a b. a -> Either a b
Left (() -> IO (Either () e)) -> () -> IO (Either () e)
forall a b. (a -> b) -> a -> b
$ ())) (\e
_ -> Either () e -> IO (Either () e)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either () e -> IO (Either () e))
-> (() -> Either () e) -> () -> IO (Either () e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. () -> Either () e
forall a b. a -> Either a b
Left (() -> IO (Either () e)) -> () -> IO (Either () e)
forall a b. (a -> b) -> a -> b
$ ()) Either String e
es


getFromFile :: FilePath -> (BS.ByteString -> Either String a) -> IO (Either String a)
getFromFile :: forall a.
String -> (ByteString -> Either String a) -> IO (Either String a)
getFromFile String
filename ByteString -> Either String a
fcast = (Either String ByteString -> Either String a)
-> IO (Either String ByteString) -> IO (Either String a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Either String a
fcast (ByteString -> Either String a)
-> Either String ByteString -> Either String a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (IO ByteString -> IO (Either String ByteString)
forall a. IO a -> IO (Either String a)
try' (IO ByteString -> IO (Either String ByteString))
-> IO ByteString -> IO (Either String ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BS.readFile String
filename)

writeToFile :: FilePath -> Int -> IO (Either String ())
writeToFile :: String -> Int -> IO (Either String ())
writeToFile String
filename Int
value = IO () -> IO (Either String ())
forall a. IO a -> IO (Either String a)
try' (IO () -> IO (Either String ())) -> IO () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
writeFile String
filename (Int -> String
forall a. Show a => a -> String
show Int
value)

try' :: forall a . IO a -> IO (Either String a)
try' :: forall a. IO a -> IO (Either String a)
try' IO a
x = (Either IOError a -> Either String a)
-> IO (Either IOError a) -> IO (Either String a)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((IOError -> String) -> Either IOError a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first IOError -> String
forall a. Show a => a -> String
show) (IO a -> IO (Either IOError a)
forall e a. Exception e => IO a -> IO (Either e a)
try IO a
x :: IO (Either IOError a))