msu 0.0.1 → 0.0.2

raw patch · 6 files changed

+161/−7 lines, 6 files

Files

• MSU/Display.hs +11/−0
• MSU/Hooks.hs +27/−0
• MSU/Xrandr/Command.hs +59/−0
• MSU/Xrandr/Parse.hs +55/−0
• main.hs +3/−6
• msu.cabal +6/−1

@@ -0,0 +1,11 @@+module MSU.Display where++data Mode = Mode Int Int++instance Show Mode where+    show (Mode w h) = show w ++ "x" ++ show h++data Display = Display+    { name  :: String+    , modes :: [Mode]+    }

@@ -0,0 +1,27 @@+module MSU.Hooks where++import Control.Monad+import System.Directory+import System.Environment.XDG.BaseDir+import System.FilePath ((</>))++runHook :: (String -> IO ()) -> String -> IO ()+runHook run h = do+    hookFile <- findHookFile h+    isExec   <- isExecutable hookFile++    when isExec $ run hookFile++findHookFile :: String -> IO FilePath+findHookFile h = do+    dir <- getUserConfigDir "msu"++    return $ dir </> h++isExecutable :: FilePath -> IO Bool+isExecutable fp = do+    exists <- doesFileExist fp++    if exists+        then return . executable =<< getPermissions fp+        else return False

@@ -0,0 +1,59 @@+module MSU.Xrandr.Command where++import Control.Monad+import Control.Monad.Writer+import MSU.Display++type Xrandr a = Writer String a++output :: Display -> Xrandr ()+output d = tell $ " --output " ++ name d++off :: Xrandr ()+off = tell " --off"++mode :: Mode -> Xrandr ()+mode m = tell $ " --mode " ++ show m++rightOf :: Display -> Xrandr ()+rightOf d = tell $ " --right-of " ++ name d++outputOff :: Display -> Xrandr ()+outputOff d = output d >> off++-- | Return @False@ if the output was not connected.+outputOn :: Display -> Xrandr Bool+outputOn   (Display _ []   ) = return False+outputOn d@(Display _ (m:_)) = output d >> mode m >> return True++allOff :: [Display] -> Xrandr ()+allOff = mapM_ outputOff++firstOn :: [Display] -> Xrandr ()+firstOn []     = return ()+firstOn (d:ds) = outputOn d ||> firstOn ds++extend :: (Display -> Xrandr ()) -> [Display] -> Xrandr ()+extend f = fold1M_ (placeWith f)++placeWith :: (Display -> Xrandr ()) -> Display -> Display -> Xrandr Display+placeWith placementCmd primary secondary = do+    didTurnOn <- outputOn secondary++    if didTurnOn+        then do+            placementCmd primary+            return secondary+        else return primary++buildCommand :: (Xrandr a) -> String+buildCommand f = execWriter $ tell "xrandr" >> f++-- | Executes the second action IFF the first returns @False@.+(||>) :: Monad m => m Bool -> m () -> m ()+f ||> g = f >>= \b -> unless b g++-- | Like foldM_ but uses first element as base value+fold1M_ :: Monad m => (b -> b -> m b) -> [b] -> m ()+fold1M_ _ [] = return ()+fold1M_ f (x:xs) = foldM_ f x xs

@@ -0,0 +1,55 @@+module MSU.Xrandr.Parse where++import MSU.Display+import Text.Parsec+import Text.Parsec.String++parseXrandr :: String -> Either ParseError [Display]+parseXrandr = parse parseDisplays "xrandr --query"++parseDisplays :: Parser [Display]+parseDisplays = do+    string "Screen" >> ignoreLine++    manyTill parseDisplay eof++parseDisplay :: Parser Display+parseDisplay = do+    n <- manyTill anyToken space+    c <- string "connected" <|> string "disconnected"+    ignoreLine++    ms <- if c == "connected"+            then parseModeLines+            else skipModeLines++    return $ Display n ms++parseModeLines :: Parser [Mode]+parseModeLines = manyTill parseModeLine nextDisplay++skipModeLines :: Parser [Mode]+skipModeLines = ignoreLinesTill nextDisplay >> return []++parseModeLine :: Parser Mode+parseModeLine = do+    w <- spaces >> many digit+    h <- char 'x' >> many digit+    ignoreLine++    return $ Mode (read w) (read h)++nextDisplay :: Parser ()+nextDisplay = lookAhead $ try parseDisplay >> return ()++ignoreLinesTill :: Parser () -> Parser ()+ignoreLinesTill p = do+    _ <- manyTill ignoreLine $ p <|> eof+    return ()++ignoreLine :: Parser ()+ignoreLine = manyTill anyToken eol >> return ()++    where+        eol :: Parser Char+        eol = char '\n'

@@ -1,6 +1,5 @@ module Main where -import Data.List (partition) import MSU.Display import MSU.Hooks import MSU.Xrandr.Command@@ -20,11 +19,9 @@  defaultCommand :: [Display] -> String defaultCommand displays = buildCommand $ do-    let (connected, disconnected) = partition isConnected displays--    allOff disconnected-    firstOn connected-    extendRight connected+    allOff displays+    firstOn displays+    extend rightOf displays  runCmd :: String -> IO () runCmd cmd = do

@@ -1,5 +1,5 @@ name:          msu-version:       0.0.1+version:       0.0.2 synopsis:      Monitor Setup Utility description:   Convenient wrapper over xrandr for setting up monitors homepage:      http://github.com/pbrisbin/msu@@ -14,6 +14,11 @@   main-is: main.hs    ghc-options: -Wall++  other-modules: MSU.Display+               , MSU.Hooks+               , MSU.Xrandr.Command+               , MSU.Xrandr.Parse    build-depends: base == 4.*                , directory