packages feed

maclight (empty) → 0.1.0.0

raw patch · 6 files changed

+176/−0 lines, 6 filesdep +HUnitdep +basedep +filemanipsetup-changed

Dependencies added: HUnit, base, filemanip, filepath, maclight, optparse-applicative, parsec, strict, test-framework, test-framework-hunit

Files

+ LICENSE view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ maclight.cabal view
@@ -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 <tycho@tycho.ws>+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
+ src/Apple/Maclight.hs view
@@ -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
+ src/maclight.hs view
@@ -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)
+ tests/MaclightTest.hs view
@@ -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)