{-# LANGUAGE ViewPatterns, PatternGuards #-}
module Apple.Maclight (
  getDirectory,
  Light(..),
  Command(..),
  Settings(..),
  handleBacklight,
  ) where

import Data.List

import System.FilePath

import qualified System.IO.Strict as S

data Command = Up | Down | Max | Off | Set Int deriving (Int -> Command -> ShowS
[Command] -> ShowS
Command -> String
(Int -> Command -> ShowS)
-> (Command -> String) -> ([Command] -> ShowS) -> Show Command
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Command -> ShowS
showsPrec :: Int -> Command -> ShowS
$cshow :: Command -> String
show :: Command -> String
$cshowList :: [Command] -> ShowS
showList :: [Command] -> ShowS
Show, Command -> Command -> Bool
(Command -> Command -> Bool)
-> (Command -> Command -> Bool) -> Eq Command
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Command -> Command -> Bool
== :: Command -> Command -> Bool
$c/= :: Command -> Command -> Bool
/= :: Command -> Command -> Bool
Eq)

instance Read Command where
  readsPrec :: Int -> ReadS Command
readsPrec Int
_ String
s | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"up" = [(Command
Up, String
"")]
                | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"down" = [(Command
Down, String
"")]
                | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"max" = [(Command
Max, String
"")]
                | String
s String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"off" = [(Command
Off, String
"")]
  readsPrec Int
_ (String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"set=" -> Just String
s) = [(Int -> Command
Set (String -> Int
forall a. Read a => String -> a
read String
s), String
"")]
  readsPrec Int
_ String
_ = []

data Light = Screen | Keyboard

instance Read Light where
  readsPrec :: Int -> ReadS Light
readsPrec Int
_ String
s = case String
s of
                    String
"screen" -> [(Light
Screen, String
"")]
                    String
"keyboard" -> [(Light
Keyboard, String
"")]
                    String
_ -> []

data Settings = Settings { Settings -> String
sysPath :: FilePath
                         , Settings -> Int
stepCount :: Int
                         }

getDirectory :: Light -> FilePath
getDirectory :: Light -> String
getDirectory Light
Screen = String
"/sys/class/backlight/intel_backlight/"
getDirectory Light
Keyboard = String
"/sys/class/leds/smc::kbd_backlight/"

handleBacklight :: Light -> Command -> IO ()
handleBacklight :: Light -> Command -> IO ()
handleBacklight Light
light Command
command = do
  let path :: String
path = Light -> String
getDirectory Light
light
  maxB <- String -> IO Int
readInt (String -> IO Int) -> String -> IO Int
forall a b. (a -> b) -> a -> b
$ String
path String -> ShowS
</> String
"max_brightness"
  current <- readInt $ path </> "brightness"
  let new = case Command
command of
              Command
Up -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
maxB (Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
maxB Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16))
              Command
Down -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
current Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
maxB Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
16))
              Command
Max -> Int
maxB
              Command
Off -> Int
0
              Set Int
i -> Int
i
  writeFile (path </> "brightness") (show new)
    where
      readInt :: FilePath -> IO Int
      readInt :: String -> IO Int
readInt String
path = do
        str <- String -> IO String
S.readFile String
path
        let [(v, _)] = reads str :: [(Int, String)]
        return v