diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,21 @@ +// MIT + +Copyright (c) 2014 Tycho Andersen + +Permission is hereby granted, free of charge, to any person obtaining a copy +of this software and associated documentation files (the "Software"), to deal +in the Software without restriction, including without limitation the rights +to use, copy, modify, merge, publish, distribute, sublicense, and/or sell +copies of the Software, and to permit persons to whom the Software is +furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in all +copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, +OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE +SOFTWARE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/maclight.cabal b/maclight.cabal new file mode 100644 --- /dev/null +++ b/maclight.cabal @@ -0,0 +1,44 @@ +name: maclight +version: 0.1.0.0 +synopsis: Control screen and keyboard backlights on MACs under Linux +homepage: http://github.com/tych0/maclight +license: MIT +license-file: LICENSE +author: Tycho Andersen +maintainer: Tycho Andersen +category: Apple +build-type: Simple +cabal-version: >=1.8 +bug-reports: https://github.com/tych0/maclight/issues +description: Maclight is both a library and a command line program for + controlling the backlight on Macbooks under linux. + +source-repository head + type: git + location: git://github.com/tych0/maclight.git + +library + build-depends: base ==4.*, filemanip >= 0.3, filepath >= 1.3, parsec >= 3.1, + strict >= 0.3 + hs-source-dirs: src + exposed-modules: Apple.Maclight + ghc-options: -Wall + +executable maclight + main-is: maclight.hs + hs-source-dirs: src + build-depends: base ==4.*, filemanip >= 0.3, filepath >= 1.3, + optparse-applicative >= 0.5, strict >= 0.3, + maclight >= 0.1.0.0 + ghc-options: -Wall + +test-suite MaclightTest.hs + hs-source-dirs: tests + main-is: MaclightTest.hs + type: exitcode-stdio-1.0 + build-depends: base ==4.*, + maclight >= 0.1.0.0, + HUnit, + test-framework, + test-framework-hunit + ghc-options: -Wall diff --git a/src/Apple/Maclight.hs b/src/Apple/Maclight.hs new file mode 100644 --- /dev/null +++ b/src/Apple/Maclight.hs @@ -0,0 +1,59 @@ +{-# 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 (Show, Eq) + +instance Read Command where + readsPrec _ s | s == "up" = [(Up, "")] + | s == "down" = [(Down, "")] + | s == "max" = [(Max, "")] + | s == "off" = [(Off, "")] + readsPrec _ (stripPrefix "set=" -> Just s) = [(Set (read s), "")] + readsPrec _ _ = [] + +data Light = Screen | Keyboard + +instance Read Light where + readsPrec _ s = case s of + "screen" -> [(Screen, "")] + "keyboard" -> [(Keyboard, "")] + _ -> [] + +data Settings = Settings { sysPath :: FilePath + , stepCount :: Int + } + +getDirectory :: Light -> FilePath +getDirectory Screen = "/sys/class/backlight/intel_backlight/" +getDirectory Keyboard = "/sys/class/leds/smc::kbd_backlight/" + +handleBacklight :: Light -> Command -> IO () +handleBacklight light command = do + let path = getDirectory light + maxB <- readInt $ path "max_brightness" + current <- readInt $ path "brightness" + let new = case command of + Up -> min maxB (current + (maxB `div` 16)) + Down -> max 0 (current - (maxB `div` 16)) + Max -> maxB + Off -> 0 + Set i -> i + writeFile (path "brightness") (show new) + where + readInt :: FilePath -> IO Int + readInt path = do + str <- S.readFile path + let [(v, _)] = reads str :: [(Int, String)] + return v diff --git a/src/maclight.hs b/src/maclight.hs new file mode 100644 --- /dev/null +++ b/src/maclight.hs @@ -0,0 +1,28 @@ +module Main where + +import Options.Applicative + +import Apple.Maclight + +data MaclightOpts = MaclightOpts { backlight :: Light + , lightCommand :: Command + } + +options :: Parser MaclightOpts +options = MaclightOpts + <$> argument auto + ( metavar "LIGHT" + <> help "The backlight to control (one of 'keyboard' or 'screen')" ) + <*> argument auto + ( metavar "CMD" + <> help ( unlines ["What to do to the backlight ", + "(one of up, down, max, off, or set=n)"] )) + +main :: IO () +main = execParser parser >>= run + where + parser = info (helper <*> options) + ( fullDesc + <> progDesc "Control a Macbook's backlight" + <> header "maclight - a Macbook backlight controller" ) + run opts = handleBacklight (backlight opts) (lightCommand opts) diff --git a/tests/MaclightTest.hs b/tests/MaclightTest.hs new file mode 100644 --- /dev/null +++ b/tests/MaclightTest.hs @@ -0,0 +1,22 @@ +module Main (main) where + +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit hiding (Test) + +import Apple.Maclight + +commandReadTests :: [(String, Command)] +commandReadTests = [ ("up", Up) + , ("down", Down) + , ("max", Max) + , ("off", Off) + , ("set=1", Set 1) + ] + +makeCommandReadTest :: (String, Command) -> Test +makeCommandReadTest (inp, expected) = + testCase inp (assertEqual inp expected (read inp)) + +main :: IO() +main = defaultMain (map makeCommandReadTest commandReadTests)