{-# LANGUAGE RecordWildCards #-} module MSU.Xrandr.Parse ( Display(..) , parseXrandr , parseXrandrUnsafe ) where import Control.Monad (void) import Control.Monad.IO.Class (MonadIO) import Text.Parsec import Text.Parsec.String import UnliftIO.Exception (throwString) data Display = Display { Display -> String name :: String , Display -> Bool connected :: Bool , Display -> [(Int, Int)] modes :: [(Int, Int)] } deriving (Display -> Display -> Bool (Display -> Display -> Bool) -> (Display -> Display -> Bool) -> Eq Display forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Display -> Display -> Bool $c/= :: Display -> Display -> Bool == :: Display -> Display -> Bool $c== :: Display -> Display -> Bool Eq, Int -> Display -> ShowS [Display] -> ShowS Display -> String (Int -> Display -> ShowS) -> (Display -> String) -> ([Display] -> ShowS) -> Show Display forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Display] -> ShowS $cshowList :: [Display] -> ShowS show :: Display -> String $cshow :: Display -> String showsPrec :: Int -> Display -> ShowS $cshowsPrec :: Int -> Display -> ShowS Show) parseXrandr :: String -> Either ParseError [Display] parseXrandr :: String -> Either ParseError [Display] parseXrandr = Parsec String () [Display] -> String -> String -> Either ParseError [Display] forall s t a. Stream s Identity t => Parsec s () a -> String -> s -> Either ParseError a parse Parsec String () [Display] parseDisplays String "xrandr --query" parseXrandrUnsafe :: MonadIO m => String -> m [Display] parseXrandrUnsafe :: String -> m [Display] parseXrandrUnsafe = (ParseError -> m [Display]) -> ([Display] -> m [Display]) -> Either ParseError [Display] -> m [Display] forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (String -> m [Display] forall (m :: * -> *) a. (MonadIO m, HasCallStack) => String -> m a throwString (String -> m [Display]) -> (ParseError -> String) -> ParseError -> m [Display] forall b c a. (b -> c) -> (a -> b) -> a -> c . ParseError -> String forall a. Show a => a -> String show) [Display] -> m [Display] forall (f :: * -> *) a. Applicative f => a -> f a pure (Either ParseError [Display] -> m [Display]) -> (String -> Either ParseError [Display]) -> String -> m [Display] forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> Either ParseError [Display] parseXrandr parseDisplays :: Parser [Display] parseDisplays :: Parsec String () [Display] parseDisplays = String -> ParsecT String () Identity String forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String string String "Screen" ParsecT String () Identity String -> ParsecT String () Identity () -> ParsecT String () Identity () forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT String () Identity () ignoreLine ParsecT String () Identity () -> Parsec String () [Display] -> Parsec String () [Display] forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT String () Identity Display -> ParsecT String () Identity () -> Parsec String () [Display] forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String () Identity Display parseDisplay ParsecT String () Identity () forall s (m :: * -> *) t u. (Stream s m t, Show t) => ParsecT s u m () eof parseDisplay :: Parser Display parseDisplay :: ParsecT String () Identity Display parseDisplay = do String name <- ParsecT String () Identity Char -> ParsecT String () Identity Char -> ParsecT String () Identity String forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String () Identity Char forall s (m :: * -> *) t u. (Stream s m t, Show t) => ParsecT s u m t anyToken ParsecT String () Identity Char forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char space Bool connected <- Parser Bool parseConnected Parser Bool -> ParsecT String () Identity () -> Parser Bool forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT String () Identity () ignoreLine [(Int, Int)] modes <- if Bool connected then Parser [(Int, Int)] parseModeLines else Parser [(Int, Int)] skipModeLines Display -> ParsecT String () Identity Display forall (f :: * -> *) a. Applicative f => a -> f a pure Display :: String -> Bool -> [(Int, Int)] -> Display Display { Bool String [(Int, Int)] modes :: [(Int, Int)] connected :: Bool name :: String modes :: [(Int, Int)] connected :: Bool name :: String .. } parseConnected :: Parser Bool parseConnected :: Parser Bool parseConnected = Bool True Bool -> ParsecT String () Identity String -> Parser Bool forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ String -> ParsecT String () Identity String forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String string String "connected" Parser Bool -> Parser Bool -> Parser Bool forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a <|> Bool False Bool -> ParsecT String () Identity String -> Parser Bool forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ String -> ParsecT String () Identity String forall s (m :: * -> *) u. Stream s m Char => String -> ParsecT s u m String string String "disconnected" parseModeLines :: Parser [(Int, Int)] parseModeLines :: Parser [(Int, Int)] parseModeLines = ParsecT String () Identity (Int, Int) -> ParsecT String () Identity () -> Parser [(Int, Int)] forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String () Identity (Int, Int) parseModeLine ParsecT String () Identity () nextDisplay skipModeLines :: Parser [(Int, Int)] skipModeLines :: Parser [(Int, Int)] skipModeLines = [] [(Int, Int)] -> ParsecT String () Identity () -> Parser [(Int, Int)] forall (f :: * -> *) a b. Functor f => a -> f b -> f a <$ ParsecT String () Identity () -> ParsecT String () Identity () ignoreLinesTill ParsecT String () Identity () nextDisplay parseModeLine :: Parser (Int, Int) parseModeLine :: ParsecT String () Identity (Int, Int) parseModeLine = (,) (Int -> Int -> (Int, Int)) -> ParsecT String () Identity Int -> ParsecT String () Identity (Int -> (Int, Int)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (String -> Int forall a. Read a => String -> a read (String -> Int) -> ParsecT String () Identity String -> ParsecT String () Identity Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (ParsecT String () Identity () forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m () spaces ParsecT String () Identity () -> ParsecT String () Identity String -> ParsecT String () Identity String forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT String () Identity Char -> ParsecT String () Identity String forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a] many ParsecT String () Identity Char forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char digit)) ParsecT String () Identity (Int -> (Int, Int)) -> ParsecT String () Identity Int -> ParsecT String () Identity (Int, Int) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (String -> Int forall a. Read a => String -> a read (String -> Int) -> ParsecT String () Identity String -> ParsecT String () Identity Int forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Char -> ParsecT String () Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char 'x' ParsecT String () Identity Char -> ParsecT String () Identity String -> ParsecT String () Identity String forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b *> ParsecT String () Identity Char -> ParsecT String () Identity String forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a] many ParsecT String () Identity Char forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char digit ParsecT String () Identity String -> ParsecT String () Identity () -> ParsecT String () Identity String forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a <* ParsecT String () Identity () ignoreLine)) nextDisplay :: Parser () nextDisplay :: ParsecT String () Identity () nextDisplay = ParsecT String () Identity () -> ParsecT String () Identity () forall s (m :: * -> *) t u a. Stream s m t => ParsecT s u m a -> ParsecT s u m a lookAhead (ParsecT String () Identity () -> ParsecT String () Identity ()) -> ParsecT String () Identity () -> ParsecT String () Identity () forall a b. (a -> b) -> a -> b $ ParsecT String () Identity Display -> ParsecT String () Identity () forall (f :: * -> *) a. Functor f => f a -> f () void (ParsecT String () Identity Display -> ParsecT String () Identity ()) -> ParsecT String () Identity Display -> ParsecT String () Identity () forall a b. (a -> b) -> a -> b $ ParsecT String () Identity Display -> ParsecT String () Identity Display forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a try ParsecT String () Identity Display parseDisplay ignoreLinesTill :: Parser () -> Parser () ignoreLinesTill :: ParsecT String () Identity () -> ParsecT String () Identity () ignoreLinesTill ParsecT String () Identity () p = ParsecT String () Identity [()] -> ParsecT String () Identity () forall (f :: * -> *) a. Functor f => f a -> f () void (ParsecT String () Identity [()] -> ParsecT String () Identity ()) -> ParsecT String () Identity [()] -> ParsecT String () Identity () forall a b. (a -> b) -> a -> b $ ParsecT String () Identity () -> ParsecT String () Identity () -> ParsecT String () Identity [()] forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String () Identity () ignoreLine (ParsecT String () Identity () -> ParsecT String () Identity [()]) -> ParsecT String () Identity () -> ParsecT String () Identity [()] forall a b. (a -> b) -> a -> b $ ParsecT String () Identity () p ParsecT String () Identity () -> ParsecT String () Identity () -> ParsecT String () Identity () forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a <|> ParsecT String () Identity () forall s (m :: * -> *) t u. (Stream s m t, Show t) => ParsecT s u m () eof ignoreLine :: Parser () ignoreLine :: ParsecT String () Identity () ignoreLine = ParsecT String () Identity String -> ParsecT String () Identity () forall (f :: * -> *) a. Functor f => f a -> f () void (ParsecT String () Identity String -> ParsecT String () Identity ()) -> ParsecT String () Identity String -> ParsecT String () Identity () forall a b. (a -> b) -> a -> b $ ParsecT String () Identity Char -> ParsecT String () Identity Char -> ParsecT String () Identity String forall s (m :: * -> *) t u a end. Stream s m t => ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a] manyTill ParsecT String () Identity Char forall s (m :: * -> *) t u. (Stream s m t, Show t) => ParsecT s u m t anyToken ParsecT String () Identity Char eol where eol :: Parser Char eol :: ParsecT String () Identity Char eol = Char -> ParsecT String () Identity Char forall s (m :: * -> *) u. Stream s m Char => Char -> ParsecT s u m Char char Char '\n'