Brighness change - Haskell

{-# LANGUAGE OverloadedStrings #-}
module Main (main) where

import System.IO (stdin, hReady, hSetEcho, hSetBuffering, BufferMode(NoBuffering))
import Data.Text.Read (decimal)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

data Action = BIncrease | BDecrease | Noop

currentHwBacklightPath = "/sys/class/backlight/intel_backlight/brightness"
maxHwBacklightPath = "/sys/class/backlight/intel_backlight/max_brightness"
maxLgBrightness = 20 -- Logical brightness, number of steps

getKeyCode :: IO [Char]
getKeyCode = reverse <$> getKeyCode' ""
  where
    getKeyCode' chars = do
      char <- getChar
      more <- hReady stdin
      (if more then getKeyCode' else return) (char:chars)

getAction :: IO Action
getAction = do
  hSetBuffering stdin NoBuffering
  hSetEcho stdin False
  key <- getKeyCode
  return $ case key of
    "\ESC[A" -> BIncrease -- Up arrow
    "\ESC[B" -> BDecrease -- Down arrow
    "\ESC[C" -> BIncrease -- Right arrow
    "\ESC[D" -> BDecrease -- Left arrow
    _        -> Noop

readFileInt0 :: FilePath -> IO Int
readFileInt0 path = textToInt0 <$> TIO.readFile path
  where textToInt0 text = either (const 0) fst (decimal text)

writeFileInt :: FilePath -> Int -> IO ()
writeFileInt path val = TIO.writeFile path (intToText val)
  where intToText = T.pack . show

getBrightness :: IO Int
getBrightness = do
  maxHwBrightness <- readFileInt0 maxHwBacklightPath
  curHwBrightness <- readFileInt0 currentHwBacklightPath

  let curLgBrightness = hwToLg maxHwBrightness curHwBrightness
  return $ max 1 curLgBrightness -- never return 0

setBrightness :: Int -> IO ()
setBrightness newLgBrightness = do
  maxHwBrightness <- readFileInt0 maxHwBacklightPath

  let newHwBrightness = lgToHw maxHwBrightness newLgBrightness
  if newLgBrightness >= 1 && newLgBrightness <= maxLgBrightness
    then do writeFileInt currentHwBacklightPath newHwBrightness
            putStrLn $ "New brightness: " ++ (show newLgBrightness)
    else return ()

hwToLg = convert logBase
lgToHw = convert (**)

-- op must be either logBase or (**)
convert op maxHw val =
  let
    base = (fromIntegral maxHw) ** (1.0 / (fromIntegral  maxLgBrightness))
  in
    round $ op base (fromIntegral val)

main = do
  action <- getAction
  curBrightness <- getBrightness
  case action of
    BIncrease -> setBrightness (curBrightness + 1) >> main
    BDecrease -> setBrightness (curBrightness - 1) >> main
    Noop -> return ()