XRandR parsing with parsec

XRandR.hs

{-
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)

XRandRMain.hs

{- 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