REF move intel backlight IO crap into separate module

lib/XMonad/Internal/DBus/IntelBacklight.hs

@@ -2,11 +2,7 @@
 -- | DBus module for Intel Backlight control
 
 module XMonad.Internal.DBus.IntelBacklight
-  ( callDecBrightness
+  ( callGetBrightness
-  , callGetBrightness
-  , callIncBrightness
-  , callMaxBrightness
-  , callMinBrightness
   , exportIntelBacklight
   , matchSignal
   , hasBacklight
@@ -16,40 +12,25 @@ module XMonad.Internal.DBus.IntelBacklight
 
 import           Control.Monad               (void)
 
-import           Data.Char
 import           Data.Either
 import           Data.Int                    (Int32)
-import           Data.Text                   (pack, unpack)
-import           Data.Text.IO                as T (readFile, writeFile)
 
 import           DBus
 import           DBus.Client
 
-import           System.Directory
 import           System.FilePath.Posix
-import           System.IO.Error
 
 import           XMonad.Internal.DBus.Common
+import           XMonad.Internal.IO
 
 --------------------------------------------------------------------------------
 -- | Low level sysfs functions
 --
--- Distinguish between "raw" brightness "normalized" brightness with two type
--- synonyms. The former is the value read directly in sysfs and generally goes
--- from 1 (min brightness) to some multiple 1000's number (note that raw values
--- of 0 turn the monitor off). The latter is the raw brightness scaled from 0 to
--- 10000 (which can easily be converted to a percent).
-
--- use strict IO here, the data in these files is literally 1-10 bytes
-
 type Brightness = Float
 
 type RawBrightness = Int32
 
-maxBrightness :: Brightness
+steps :: Int
-maxBrightness = 10000
-
-steps :: Brightness
 steps = 16
 
 backlightDir :: FilePath
@@ -61,42 +42,23 @@ maxFile = backlightDir </> "max_brightness"
 curFile :: FilePath
 curFile = backlightDir </> "brightness"
 
-toFloat :: Integral a => a -> Float
-toFloat = fromIntegral
-
-readFileInt :: FilePath -> IO RawBrightness
-readFileInt file = read . takeWhile isDigit . unpack <$> T.readFile file
-
 getMaxRawBrightness :: IO RawBrightness
-getMaxRawBrightness = readFileInt maxFile
+getMaxRawBrightness = readInt maxFile
-
-getRawBrightness :: IO RawBrightness
-getRawBrightness = readFileInt curFile
-
-setRawBrightness :: RawBrightness -> IO ()
-setRawBrightness = T.writeFile curFile . pack . show
-
-rawToNorm :: RawBrightness -> RawBrightness -> Brightness
-rawToNorm maxb cur = maxBrightness * (toFloat cur - 1) / (toFloat maxb - 1)
-
-normToRaw :: RawBrightness -> Brightness -> RawBrightness
-normToRaw maxb cur = round $ 1 + cur / maxBrightness * (toFloat maxb - 1)
-
-truncateNorm :: Brightness -> Brightness
-truncateNorm = min maxBrightness . max 0
 
 getBrightness :: RawBrightness -> IO Brightness
-getBrightness maxRaw = rawToNorm maxRaw <$> getRawBrightness
+getBrightness upper = readPercent upper curFile
 
-changeBrightness :: RawBrightness -> Brightness -> IO Brightness
+minBrightness :: RawBrightness -> IO Brightness
-changeBrightness maxRaw delta = setBrightness maxRaw
+minBrightness upper = writePercentMin upper curFile
-  . (+ delta) =<< getBrightness maxRaw
 
-setBrightness :: RawBrightness -> Brightness -> IO Brightness
+maxBrightness :: RawBrightness -> IO Brightness
-setBrightness maxRaw newNorm = do
+maxBrightness upper = writePercentMax upper curFile
-  let newNorm' = truncateNorm newNorm
+
-  setRawBrightness $ normToRaw maxRaw newNorm'
+incBrightness :: RawBrightness -> IO Brightness
-  return newNorm'
+incBrightness = incPercent steps curFile
+
+decBrightness :: RawBrightness -> IO Brightness
+decBrightness = decPercent steps curFile
 
 --------------------------------------------------------------------------------
 -- | Access checks
@@ -107,17 +69,13 @@ setBrightness maxRaw newNorm = do
 -- Left x -> backlight present but could not access (x explaining why)
 hasBacklight' :: IO (Either String Bool)
 hasBacklight' = do
-  mx <- doesFileExist maxFile
+  mx <- isReadable maxFile
-  cx <- doesFileExist curFile
+  cx <- isWritable curFile
-  if not $ mx || cx
+  return $ case (mx, cx) of
-    then return $ Right False
+    (NotFoundError, NotFoundError) -> Right False
-    else do
+    (PermResult True, PermResult True) -> Right True
-    mp <- tryIOError $ readable <$> getPermissions maxFile
+    (PermResult _, PermResult _) -> Left "Insufficient permissions for backlight files"
-    cp <- tryIOError $ (\p -> writable p && readable p) <$> getPermissions curFile
+    _ -> Left "Could not determine permissions for backlight files"
-    return $ case (mp, cp) of
-      (Right True, Right True) -> Right True
-      (Right _, Right _) -> Left "Insufficient permissions for backlight files"
-      _                  -> Left "Could not determine backlight file permissions"
 
 msg :: Either String Bool -> IO ()
 msg (Right True)  = return ()
@@ -180,7 +138,7 @@ callBacklight :: MemberName -> IO ()
 callBacklight method = void $ callMethod $ methodCall blPath interface method
 
 bodyGetBrightness :: [Variant] -> Maybe Brightness
-bodyGetBrightness [b] = toFloat <$> (fromVariant b :: Maybe Int32)
+bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
 bodyGetBrightness _   = Nothing
 
 --------------------------------------------------------------------------------
@@ -196,30 +154,30 @@ data BacklightControls = BacklightControls
 exportIntelBacklight :: Client -> IO (Maybe BacklightControls)
 exportIntelBacklight client = do
   b <- hasBacklightMsg
-  if b then Just <$> exportIntelBacklight' client else return Nothing
+  if b then exportIntelBacklight' client >> return (Just bc) else return Nothing
-
+  where
-exportIntelBacklight' :: Client -> IO BacklightControls
+    bc =  BacklightControls
-exportIntelBacklight' client = do
-  maxval <- getMaxRawBrightness -- assume the max value will never change
-  let stepsize = maxBrightness / steps
-  let emit' = emitBrightness client
-  export client blPath defaultInterface
-    { interfaceName = interface
-    , interfaceMethods =
-      [ autoMethod memMaxBrightness $ emit' =<< setBrightness maxval maxBrightness
-      , autoMethod memMinBrightness $ emit' =<< setBrightness maxval 0
-      , autoMethod memIncBrightness $ emit' =<< changeBrightness maxval stepsize
-      , autoMethod memDecBrightness $ emit' =<< changeBrightness maxval (-stepsize)
-      , autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
-      ]
-    }
-  return $ BacklightControls
       { backlightMax = callMaxBrightness
       , backlightMin = callMinBrightness
       , backlightUp = callIncBrightness
       , backlightDown = callDecBrightness
       }
 
+exportIntelBacklight' :: Client -> IO ()
+exportIntelBacklight' client = do
+  maxval <- getMaxRawBrightness -- assume the max value will never change
+  let emit' f = emitBrightness client =<< f maxval
+  export client blPath defaultInterface
+    { interfaceName = interface
+    , interfaceMethods =
+      [ autoMethod memMaxBrightness $ emit' maxBrightness
+      , autoMethod memMinBrightness $ emit' minBrightness
+      , autoMethod memIncBrightness $ emit' incBrightness
+      , autoMethod memDecBrightness $ emit' decBrightness
+      , autoMethod memGetBrightness (round <$> getBrightness maxval :: IO Int32)
+      ]
+    }
+
 emitBrightness :: Client -> Brightness -> IO ()
 emitBrightness client cur = emit client
   $ brSignal { signalBody = [toVariant (round cur :: Int32)] }

lib/XMonad/Internal/IO.hs

@@ -0,0 +1,122 @@
+{-# LANGUAGE ViewPatterns #-}
+
+--------------------------------------------------------------------------------
+-- | Random IO-ish functions used throughtout xmonad
+--
+-- Most (probably all) of these functions are intended to work with sysfs where
+-- some safe assumptions can be made about file contents.
+
+module XMonad.Internal.IO
+  ( readInt
+  , readBool
+  , readPercent
+  , writeInt
+  , writeBool
+  , writePercent
+  , writePercentMin
+  , writePercentMax
+  , decPercent
+  , incPercent
+  , isReadable
+  , isWritable
+  , PermResult(..)
+  ) where
+
+import           Data.Char
+import           Data.Text        (pack, unpack)
+import           Data.Text.IO     as T (readFile, writeFile)
+
+import           System.Directory
+import           System.IO.Error
+
+--------------------------------------------------------------------------------
+-- | read
+
+readInt :: (Read a, Integral a) => FilePath -> IO a
+readInt = fmap (read . takeWhile isDigit . unpack) . T.readFile
+
+readBool :: FilePath -> IO Bool
+readBool = fmap (==(1 :: Int)) . readInt
+
+--------------------------------------------------------------------------------
+-- | write
+
+writeInt :: (Show a, Integral a) => FilePath -> a -> IO ()
+writeInt f = T.writeFile f . pack . show
+
+writeBool :: FilePath -> Bool -> IO ()
+writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
+
+--------------------------------------------------------------------------------
+-- | percent-based read/write
+--
+-- "Raw" values are whatever is stored in sysfs and "percent" is the user-facing
+-- value. Assume that the file being read has a min of 0 and an unchanging max
+-- given by a runtime argument, which is scaled linearly to the range 0-100
+-- (percent).
+
+rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => a -> b -> c
+rawToPercent upper raw = 100 * (fromIntegral raw - 1) / (fromIntegral upper - 1)
+
+readPercent :: (Integral a, RealFrac b) => a -> FilePath -> IO b
+readPercent upper path = do
+  i <- readInt path
+  return $ rawToPercent upper (i :: Integer)
+
+percentToRaw :: (Integral a, RealFrac b, Integral c) => a -> b -> c
+percentToRaw upper perc = round $ 1 + perc / 100.0 * (fromIntegral upper - 1)
+
+writePercent :: (Integral a, RealFrac b) => a -> FilePath -> b -> IO b
+writePercent upper path perc = do
+  let t | perc > 100 = 100
+        | perc < 0 = 0
+        | otherwise = perc
+  writeInt path (percentToRaw upper t :: Int)
+  return t
+
+writePercentMin :: (Integral a, RealFrac b) => a -> FilePath -> IO b
+writePercentMin upper path = writePercent upper path 0
+
+writePercentMax :: (Integral a, RealFrac b) => a -> FilePath -> IO b
+writePercentMax upper path = writePercent upper path 100
+
+shiftPercent :: (Integral a, RealFrac b) => (b -> b -> b) -> Int -> FilePath
+  -> a -> IO b
+shiftPercent f steps path upper = writePercent upper path . f stepsize
+    =<< readPercent upper path
+  where
+    stepsize = 100 / fromIntegral steps
+
+incPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b
+incPercent = shiftPercent (+)
+
+decPercent :: (Integral a, RealFrac b) => Int -> FilePath -> a -> IO b
+decPercent = shiftPercent subtract -- silly (-) operator thingy error
+
+--------------------------------------------------------------------------------
+-- | permission query
+
+data PermResult a = PermResult a | NotFoundError | PermError
+  deriving (Show, Eq)
+
+instance Functor PermResult where
+  fmap f (PermResult r) = PermResult $ f r
+  fmap _ NotFoundError  = NotFoundError
+  fmap _ PermError      = PermError
+
+getPermissionsSafe :: FilePath -> IO (PermResult Permissions)
+getPermissionsSafe f = do
+  r <- tryIOError $ getPermissions f
+  return $ case r of
+    Right z                            -> PermResult z
+    Left (isPermissionError -> True)   -> PermError
+    Left (isDoesNotExistError -> True) -> NotFoundError
+    -- the above error should be the only ones thrown by getPermission,
+    -- so the catchall case should never happen
+    _                                  -> error "Unknown permission error"
+
+isReadable :: FilePath -> IO (PermResult Bool)
+isReadable = fmap (fmap readable) . getPermissionsSafe
+
+isWritable :: FilePath -> IO (PermResult Bool)
+isWritable = fmap (fmap writable) . getPermissionsSafe

lib/Xmobar/Plugins/IntelBacklight.hs

@@ -31,5 +31,5 @@ instance Exec IntelBacklight where
     forever (threadDelay 5000000)
     where
       formatBrightness = \case
-        Just b  -> icon ++ show (round $ b / 100 :: Integer) ++ "%"
+        Just b  -> icon ++ show (round b :: Integer) ++ "%"
         Nothing -> "N/A"

my-xmonad.cabal

@@ -12,6 +12,7 @@ library
                    , XMonad.Internal.Theme
                    , XMonad.Internal.Notify
                    , XMonad.Internal.Shell
+                   , XMonad.Internal.IO
                    , XMonad.Internal.Command.Desktop
                    , XMonad.Internal.Command.DMenu
                    , XMonad.Internal.Command.Power