Last active
August 29, 2015 14:08
-
-
Save melrief/10e26fc03c58e0b09e08 to your computer and use it in GitHub Desktop.
XRandR parsing with parsec
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- | |
Parsing the output of the xrandr command. For example: | |
$> xrandr | |
Screen 0: minimum 8 x 8, current 1920 x 1080, maximum 32767 x 32767 | |
eDP1 connected 1920x1080+0+0 (normal left inverted right x axis y axis) 309mm x 173mm | |
1920x1080 60.0*+ 59.9 | |
1680x1050 60.0 59.9 | |
1600x1024 60.2 | |
1400x1050 60.0 | |
1280x1024 60.0 | |
1440x900 59.9 | |
1280x960 60.0 | |
1360x768 59.8 60.0 | |
1152x864 60.0 | |
1024x768 60.0 | |
800x600 60.3 56.2 | |
640x480 59.9 | |
DP1 disconnected (normal left inverted right x axis y axis) | |
HDMI1 disconnected (normal left inverted right x axis y axis) | |
HDMI2 disconnected (normal left inverted right x axis y axis) | |
VGA1 disconnected (normal left inverted right x axis y axis) | |
VIRTUAL1 disconnected (normal left inverted right x axis y axis) | |
-} | |
module XMonad.Actions.XRandR | |
(parseXRandR | |
,runXRandR | |
,showDisplay | |
,showDisplays | |
) | |
where | |
import Control.Applicative ((<$>),(<|>)) | |
import Control.Monad (void) | |
import Control.Monad.IO.Class (MonadIO) | |
import qualified Data.List as List | |
import qualified Data.Map as Map | |
import Data.Map (Map) | |
import qualified Text.ParserCombinators.Parsec as P | |
import Text.ParserCombinators.Parsec.Char (alphaNum) | |
import Text.ParserCombinators.Parsec (Parser | |
,ParseError | |
,GenParser) | |
import XMonad.Util.Run (runProcessWithInput) | |
-- width and height | |
type Resolution = (Int,Int) | |
data XRDisplayData = XRDisplayData | |
{ isConnected :: Bool -- | if the display is connected | |
, resolutions :: [Resolution] -- | supported resolutions | |
} | |
deriving Show | |
-- A display is composed by its id and its data | |
type Display = (String,XRDisplayData) | |
type Displays = Map String XRDisplayData | |
showDisplay :: Display -> String | |
showDisplay (did,ddata) = List.intercalate "\n" (headLine:tailLines) | |
where conn = if isConnected ddata then "connected" else "disconnected" | |
headLine = did ++ ' ': conn | |
tailLines = fmap (\(w,h) -> " " ++ show w ++ 'x':show h) | |
(resolutions ddata) | |
showDisplays :: Displays -> String | |
showDisplays = List.intercalate "\n" . fmap showDisplay . Map.toList | |
runXRandR :: MonadIO m => m String | |
runXRandR = runProcessWithInput "xrandr" [] "" | |
parseXRandR :: String -> Either ParseError Displays | |
parseXRandR = P.parse xrandrOut "(unknown)" | |
-- ignore the entire line | |
skipUntilNewLine :: Parser () | |
skipUntilNewLine = P.manyTill P.anyChar P.newline >> return () | |
xrandrOut :: Parser Displays | |
xrandrOut = do | |
P.skipMany screen | |
Map.fromList <$> P.many1 display | |
--P.manyTill P.anyChar P.eof >>= error . show | |
screen :: Parser () | |
screen = P.string "Screen" >> skipUntilNewLine | |
display :: Parser Display | |
display = do | |
did <- P.many1 alphaNum | |
P.space | |
isConnected_ <- (P.string "connected" >> return True) <|> | |
(P.string "disconnected" >> return False) | |
skipUntilNewLine | |
resolutions_ <- (resolutionPrefix >> resolution `P.sepBy` resolutionPrefix) <|> | |
return [] | |
return (did,XRDisplayData isConnected_ resolutions_) | |
where | |
resolutionPrefix = P.space >> P.space >> P.space | |
resolution :: Parser Resolution | |
resolution = do | |
width <- read <$> P.many1 P.digit | |
P.char 'x' | |
height <- read <$> P.many1 P.digit | |
skipUntilNewLine | |
return (width,height) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{- Example of usage of XRandR.hs -} | |
import Control.Applicative | |
import Control.Monad | |
import Data.Map | |
import XMonad.Actions.XRandR | |
main :: IO () | |
main = do | |
res <- parseXRandR <$> runXRandR | |
case res of | |
Left err -> print err | |
Right ds -> putStrLn $ showDisplays ds |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment