diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,1 @@ +# TODO diff --git a/MSU/Display.hs b/MSU/Display.hs deleted file mode 100644 --- a/MSU/Display.hs +++ /dev/null @@ -1,11 +0,0 @@ -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] - } diff --git a/MSU/Hooks.hs b/MSU/Hooks.hs deleted file mode 100644 --- a/MSU/Hooks.hs +++ /dev/null @@ -1,27 +0,0 @@ -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 diff --git a/MSU/Xrandr/Command.hs b/MSU/Xrandr/Command.hs deleted file mode 100644 --- a/MSU/Xrandr/Command.hs +++ /dev/null @@ -1,59 +0,0 @@ -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 diff --git a/MSU/Xrandr/Parse.hs b/MSU/Xrandr/Parse.hs deleted file mode 100644 --- a/MSU/Xrandr/Parse.hs +++ /dev/null @@ -1,55 +0,0 @@ -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' diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,88 @@ +# Monitor Setup Utility + +[ARandR][] is great for setting up monitors in a minimal way. I use it when +plugging in at some random location and/or to save scripts to set things to a +known configuration. + +[arandr]: https://christian.amsuess.com/tools/arandr/ + +By contrast, this tool allows me to run a single command, with no options or +thought (e.g. from a udev hot-plug rule), and have that tool figure out where I +am and *what* saved-script (or literal command) to execute to configure my +monitors. + +Plugging into my office dock, like I do every morning? The script notes that I'm +on my home wifi and a specific Display is now connected and it does the Right +Thing. + +Unplugging to only my laptop screen connected? This script sees this and resets +to it as the single primary display. + +## Usage + +Create a configuration file that defines how to match a "context" and what +command to execute if matched: + +**~/.monitors.yaml**: + +```yaml +- name: none + match: + # Only our primary display is connected + displays: + connected: + eq: + - eDP1 + + # Turn everything else off and turn that on + exec: + xrandr + --output eDP1 --primary --mode 2560x1440 + --output DP1 --off + --output DP2 --off + --output DP2-1 --off + --output DP2-2 --off + --output DP2-3 --off + --output HDMI1 --off + --output HDMI2 --off + --output VIRTUAL1 --off + +- name: home-dual + match: + # My second display is connected + displays: + connected: + eq: + - eDP1 + - DP2-2 + + # And I'm on one of my home wifi networks + wifi: + essid: + in: + - pb-and-j + - pb-and-j-5g + + # Set up those two displays how I like + exec: + xrandr + --output eDP1 --mode 2560x1440 --right-of DP2-2 + --output DP1 --off + --output DP2 --off + --output DP2-1 --off + --output DP2-2 --primary --mode 2560x1440 + --output DP2-3 --off + --output HDMI1 --off + --output HDMI2 --off + --output VIRTUAL1 --off +``` + +Then run: + +```console +msu +``` + +--- + +[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE) diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/app/Main.hs b/app/Main.hs new file mode 100644 --- /dev/null +++ b/app/Main.hs @@ -0,0 +1,35 @@ +{-# LANGUAGE RecordWildCards #-} + +module Main + ( main + ) +where + +import MSU.Context +import MSU.Monitors +import System.Directory (getHomeDirectory) +import System.Environment (getArgs) +import System.FilePath (()) +import System.Process (callCommand) + +main :: IO () +main = do + yaml <- ( ".monitors.yaml") <$> getHomeDirectory + args <- getArgs + + case args of + ["create"] -> do + writeMonitorsFile yaml . createMonitor =<< getContext + putStrLn $ "Template monitors rule written, see: " <> yaml + + _ -> do + monitors <- + findMonitors <$> getContext <*> readMonitorsFileThrow yaml + + maybe + (putStrLn "No monitors rules matched") + (\Monitors {..} -> do + putStrLn exec + callCommand exec + ) + monitors diff --git a/main.hs b/main.hs deleted file mode 100644 --- a/main.hs +++ /dev/null @@ -1,31 +0,0 @@ -module Main where - -import MSU.Display -import MSU.Hooks -import MSU.Xrandr.Command -import MSU.Xrandr.Parse -import System.IO (hPrint, stderr) -import System.Process (readProcess, runCommand, waitForProcess) - -main :: IO () -main = do - xrandrOutput <- readProcess "xrandr" ["--query"] "" - - case parseXrandr xrandrOutput of - Left err -> hPrint stderr err - Right displays -> do - runCmd $ defaultCommand displays - runHook runCmd "after-setup" - -defaultCommand :: [Display] -> String -defaultCommand displays = buildCommand $ do - allOff displays - firstOn displays - extend rightOf displays - -runCmd :: String -> IO () -runCmd cmd = do - putStrLn cmd - _ <- waitForProcess =<< runCommand cmd - - return () diff --git a/msu.cabal b/msu.cabal --- a/msu.cabal +++ b/msu.cabal @@ -1,29 +1,74 @@ -name: msu -version: 0.0.2 -synopsis: Monitor Setup Utility -description: Convenient wrapper over xrandr for setting up monitors -homepage: http://github.com/pbrisbin/msu -license: MIT -copyright: (c) 2013 Pat Brisbin -author: Pat Brisbin -maintainer: Pat Brisbin -build-type: Simple -cabal-version: >= 1.8 +cabal-version: 1.18 -executable msu - main-is: main.hs +-- This file has been generated from package.yaml by hpack version 0.34.4. +-- +-- see: https://github.com/sol/hpack +name: msu +version: 0.2.0.0 +synopsis: Monitor Setup Utility +description: Convenient wrapper over xrandr for setting up monitors +homepage: http://github.com/pbrisbin/msu +author: Pat Brisbin +maintainer: Pat Brisbin +license: MIT +build-type: Simple +extra-doc-files: + CHANGELOG.md + README.md + +library + exposed-modules: + MSU.Context + MSU.Match + MSU.Monitors + MSU.Xrandr.Parse + other-modules: + Paths_msu + hs-source-dirs: + src ghc-options: -Wall + build-depends: + aeson + , aeson-casing + , base >=4.8.0 && <5 + , bytestring + , directory + , parsec + , process + , unliftio + , yaml + default-language: Haskell2010 - other-modules: MSU.Display - , MSU.Hooks - , MSU.Xrandr.Command - , MSU.Xrandr.Parse +executable msu + main-is: Main.hs + other-modules: + Paths_msu + hs-source-dirs: + app + ghc-options: -Wall + build-depends: + base >=4.8.0 && <5 + , directory + , filepath + , msu + , process + default-language: Haskell2010 - build-depends: base == 4.* - , directory - , filepath - , mtl - , parsec - , process - , xdg-basedir +test-suite spec + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + MSU.MonitorsSpec + MSU.Xrandr.ParseSpec + Paths_msu + hs-source-dirs: + test + ghc-options: -Wall + build-depends: + base >=4.8.0 && <5 + , bytestring + , errors + , hspec + , msu + default-language: Haskell2010 diff --git a/src/MSU/Context.hs b/src/MSU/Context.hs new file mode 100644 --- /dev/null +++ b/src/MSU/Context.hs @@ -0,0 +1,46 @@ +module MSU.Context + ( Context(..) + , getContext + , Display(..) + , getDisplays + , Wifi(..) + , getWifi + ) +where + +import Data.Char (isSpace) +import MSU.Xrandr.Parse +import System.Process (readProcess) +import UnliftIO.Exception (handleAny) + +data Context = Context + { displays :: [Display] + , wifi :: Maybe Wifi + } + +newtype Wifi = Wifi + { essid :: String + } + +getContext :: IO Context +getContext = Context <$> getDisplays <*> getWifi + +getDisplays :: IO [Display] +getDisplays = parseXrandrUnsafe =<< readProcess "xrandr" ["--query"] "" + +getWifi :: IO (Maybe Wifi) +getWifi = do + x <- getEssid + pure $ if null x then Nothing else Just $ Wifi { essid = x } + +-- TODO: do this "correctly", whatever that would be +getEssid :: IO String +getEssid = handleAny (\_ -> pure "") $ trim <$> readProcess + "sh" + ["-c", "iwconfig 2>/dev/null | " <> sed] + "" + where + sed = "sed '/^.* ESSID:\"\\([^\\\"]*\\)\".*$/!d; s//\\1/'" + + trim :: String -> String + trim = f . f where f = dropWhile isSpace . reverse diff --git a/src/MSU/Match.hs b/src/MSU/Match.hs new file mode 100644 --- /dev/null +++ b/src/MSU/Match.hs @@ -0,0 +1,54 @@ +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} + +module MSU.Match + ( Match(..) + , matches + , matchesMaybe + ) +where + +import Control.Applicative ((<|>)) +import Data.Aeson +import Data.Maybe (fromMaybe) + +data Match a + = Any + -- ^ Always matches + | Eq a + -- ^ Matches if equal + | In [a] + -- ^ Matches if element + +instance FromJSON a => FromJSON (Match a) where + parseJSON = withObject "match operator" $ \o -> do + mEq <- o .:? "eq" + mIn <- o .:? "in" + pure $ fromMaybe Any $ (Eq <$> mEq) <|> (In <$> mIn) + +instance ToJSON a => ToJSON (Match a) where + toJSON = \case + Any -> Null + Eq a -> object ["eq" .= a] + In as -> object ["in" .= as] + +-- | Apply a @'Match'@ to get @'Bool'@ +-- +-- Accepts @'Maybe'@ purefuly for convenience of current use (where matches are +-- optional keys in JSON). +-- +matches :: Eq a => Maybe (Match a) -> a -> Bool +matches = matchFn . fromMaybe Any + +-- | Apply a @'Match'@ to a @'Maybe'@ to get @'Bool'@ +-- +-- A @'Nothing'@ always matches. +-- +matchesMaybe :: Eq a => Maybe (Match a) -> Maybe a -> Bool +matchesMaybe mm = maybe True (mm `matches`) + +matchFn :: Eq a => Match a -> a -> Bool +matchFn = \case + Any -> const True + Eq a -> (== a) + In as -> (`elem` as) diff --git a/src/MSU/Monitors.hs b/src/MSU/Monitors.hs new file mode 100644 --- /dev/null +++ b/src/MSU/Monitors.hs @@ -0,0 +1,92 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +module MSU.Monitors + ( Monitors(..) + , readMonitorsFileThrow + , readMonitorsYaml + , findMonitors + + -- * Create + , createMonitor + , writeMonitorsFile + ) +where + +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Aeson +import Data.Bifunctor (first) +import Data.ByteString (ByteString) +import qualified Data.ByteString as BS +import Data.List (find) +import qualified Data.Yaml as Yaml +import GHC.Generics (Generic) +import MSU.Context (Context) +import qualified MSU.Context as Context +import MSU.Match +import qualified MSU.Xrandr.Parse as Xrandr +import System.Directory (doesFileExist) + +data Monitors = Monitors + { name :: String + , match :: MatchContext + , exec :: String + } + deriving stock Generic + deriving anyclass (FromJSON, ToJSON) + +data MatchContext = MatchContext + { displays :: Maybe (Match [String]) + , wifi :: Maybe (Match String) + } + deriving stock Generic + deriving anyclass (FromJSON, ToJSON) + +readMonitorsFileThrow :: MonadIO m => FilePath -> m [Monitors] +readMonitorsFileThrow = Yaml.decodeFileThrow + +readMonitorsYaml :: ByteString -> Either String [Monitors] +readMonitorsYaml = first show . Yaml.decodeEither' + +findMonitors :: Context -> [Monitors] -> Maybe Monitors +findMonitors context = find $ \Monitors {..} -> + let + connected = filter Xrandr.connected $ Context.displays context + names = map Xrandr.name connected + mEssid = Context.essid <$> Context.wifi context + in displays match `matches` names && wifi match `matchesMaybe` mEssid + +createMonitor :: Context -> Monitors +createMonitor context = Monitors + { name = "created" + , match = MatchContext + { displays = Just $ Eq connectedNames + , wifi = Eq . Context.essid <$> Context.wifi context + } + , exec = unwords $ ("xrandr" :) $ concatMap xrandrArg $ Context.displays + context + } + where + connectedNames = + map Xrandr.name $ filter Xrandr.connected $ Context.displays context + + xrandrArg display = + ["--output", Xrandr.name display] + <> if Xrandr.connected display then xrandrMode display else [] + + xrandrMode display = case Xrandr.modes display of + ((x, y) : _) -> ["--mode", show x <> "x" <> show y] + _ -> [] + +writeMonitorsFile :: MonadIO m => FilePath -> Monitors -> m () +writeMonitorsFile path monitors = liftIO $ do + exists <- doesFileExist path + if exists + then BS.appendFile path $ prefix <> encoded + else BS.writeFile path encoded + where + prefix = "\n# TODO: created automatically\n" + encoded = Yaml.encode [monitors] diff --git a/src/MSU/Xrandr/Parse.hs b/src/MSU/Xrandr/Parse.hs new file mode 100644 --- /dev/null +++ b/src/MSU/Xrandr/Parse.hs @@ -0,0 +1,64 @@ +{-# 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 + { name :: String + , connected :: Bool + , modes :: [(Int, Int)] + } + deriving (Eq, Show) + +parseXrandr :: String -> Either ParseError [Display] +parseXrandr = parse parseDisplays "xrandr --query" + +parseXrandrUnsafe :: MonadIO m => String -> m [Display] +parseXrandrUnsafe = either (throwString . show) pure . parseXrandr + +parseDisplays :: Parser [Display] +parseDisplays = string "Screen" *> ignoreLine *> manyTill parseDisplay eof + +parseDisplay :: Parser Display +parseDisplay = do + name <- manyTill anyToken space + connected <- parseConnected <* ignoreLine + modes <- if connected then parseModeLines else skipModeLines + pure Display { .. } + +parseConnected :: Parser Bool +parseConnected = True <$ string "connected" <|> False <$ string "disconnected" + +parseModeLines :: Parser [(Int, Int)] +parseModeLines = manyTill parseModeLine nextDisplay + +skipModeLines :: Parser [(Int, Int)] +skipModeLines = [] <$ ignoreLinesTill nextDisplay + +parseModeLine :: Parser (Int, Int) +parseModeLine = + (,) + <$> (read <$> (spaces *> many digit)) + <*> (read <$> (char 'x' *> many digit <* ignoreLine)) + +nextDisplay :: Parser () +nextDisplay = lookAhead $ void $ try parseDisplay + +ignoreLinesTill :: Parser () -> Parser () +ignoreLinesTill p = void $ manyTill ignoreLine $ p <|> eof + +ignoreLine :: Parser () +ignoreLine = void $ manyTill anyToken eol + where + eol :: Parser Char + eol = char '\n' diff --git a/test/MSU/MonitorsSpec.hs b/test/MSU/MonitorsSpec.hs new file mode 100644 --- /dev/null +++ b/test/MSU/MonitorsSpec.hs @@ -0,0 +1,96 @@ +{-# LANGUAGE OverloadedStrings #-} + +module MSU.MonitorsSpec + ( spec + ) +where + +import Test.Hspec + +import Control.Error.Util (hush) +import Control.Monad (void) +import Data.ByteString (ByteString) +import MSU.Context +import MSU.Monitors + +spec :: Spec +spec = do + describe "readMonitorsYaml" $ do + it "parses valid input" $ do + void (readMonitorsYaml monitorsYaml) `shouldBe` Right () + + describe "findMonitors" $ do + it "finds matches" $ do + let context1 = Context + { displays = + [Display "eDP1" True [], Display "DP2-2" True []] + , wifi = Just $ Wifi { essid = "pb-and-j" } + } + context2 = Context + { displays = + [Display "eDP1" True [], Display "DP2-2" True []] + , wifi = Just $ Wifi { essid = "other-wifi" } + } + context3 = Context + { displays = + [ Display "eDP1" True [] + , Display "DP2-2" True [] + , Display "DP2-3" True [] + ] + , wifi = Just $ Wifi { essid = "pb-and-j" } + } + + findMonitorsExec c = do + ms <- hush $ readMonitorsYaml monitorsYaml + exec <$> findMonitors c ms + + findMonitorsExec context1 + `shouldBe` Just + "xrandr --output eDP1 --mode 2560x1440 --right-of DP2-2 --output DP1 --off --output DP2 --off --output DP2-1 --off --output DP2-2 --primary --mode 2560x1440 --output DP2-3 --off --output HDMI1 --off --output HDMI2 --off --output VIRTUAL1 --off" + findMonitorsExec context2 `shouldBe` Nothing + findMonitorsExec context3 `shouldBe` Nothing + +monitorsYaml :: ByteString +monitorsYaml = mconcat + [ "- name: none\n" + , " match:\n" + , " displays:\n" + , " eq:\n" + , " - eDP1\n" + , "\n" + , " exec: \n" + , " xrandr\n" + , " --output eDP1 --primary --mode 2560x1440\n" + , " --output DP1 --off\n" + , " --output DP2 --off\n" + , " --output DP2-1 --off\n" + , " --output DP2-2 --off\n" + , " --output DP2-3 --off\n" + , " --output HDMI1 --off\n" + , " --output HDMI2 --off\n" + , " --output VIRTUAL1 --off\n" + , "\n" + , "- name: home-dual\n" + , " match:\n" + , " displays:\n" + , " eq:\n" + , " - eDP1\n" + , " - DP2-2\n" + , "\n" + , " wifi:\n" + , " in:\n" + , " - pb-and-j\n" + , " - pb-and-j-5g\n" + , "\n" + , " exec: \n" + , " xrandr\n" + , " --output eDP1 --mode 2560x1440 --right-of DP2-2\n" + , " --output DP1 --off\n" + , " --output DP2 --off\n" + , " --output DP2-1 --off\n" + , " --output DP2-2 --primary --mode 2560x1440\n" + , " --output DP2-3 --off\n" + , " --output HDMI1 --off\n" + , " --output HDMI2 --off\n" + , " --output VIRTUAL1 --off\n" + ] diff --git a/test/MSU/Xrandr/ParseSpec.hs b/test/MSU/Xrandr/ParseSpec.hs new file mode 100644 --- /dev/null +++ b/test/MSU/Xrandr/ParseSpec.hs @@ -0,0 +1,129 @@ +module MSU.Xrandr.ParseSpec + ( spec + ) +where + +import Test.Hspec + +import MSU.Xrandr.Parse + +spec :: Spec +spec = do + describe "parseXrandr" $ do + it "parses xrandr --query into Displays" $ do + parseXrandr xrandrQuery `shouldBe` Right + [ Display + { name = "eDP1" + , connected = True + , modes = [ (2560, 1440) + , (1920, 1440) + , (1856, 1392) + , (1792, 1344) + , (2048, 1152) + , (1920, 1200) + , (1920, 1080) + , (1600, 1200) + , (1680, 1050) + , (1400, 1050) + , (1600, 900) + , (1280, 1024) + , (1400, 900) + , (1280, 960) + , (1368, 768) + , (1280, 800) + , (1280, 720) + , (1024, 768) + , (1024, 576) + , (960, 540) + , (800, 600) + , (864, 486) + , (640, 480) + , (720, 405) + , (640, 360) + ] + } + , Display {name = "DP1", connected = False, modes = []} + , Display {name = "DP2", connected = False, modes = []} + , Display {name = "DP2-1", connected = False, modes = []} + , Display + { name = "DP2-2" + , connected = True + , modes = [ (2560, 1440) + , (2048, 1152) + , (1920, 1200) + , (1920, 1080) + , (1600, 1200) + , (1680, 1050) + , (1280, 1024) + , (1200, 960) + , (1152, 864) + , (1280, 720) + , (1024, 768) + , (800, 600) + , (720, 576) + , (720, 480) + , (640, 480) + , (720, 400) + ] + } + , Display {name = "DP2-3", connected = False, modes = []} + , Display {name = "HDMI1", connected = False, modes = []} + , Display {name = "HDMI2", connected = False, modes = []} + , Display {name = "VIRTUAL1", connected = False, modes = []} + ] + +xrandrQuery :: String +xrandrQuery = unlines + [ "Screen 0: minimum 8 x 8, current 5120 x 1440, maximum 32767 x 32767" + , "eDP1 connected 2560x1440+2560+0 (normal left inverted right x axis y axis) 310mm x 170mm" + , " 2560x1440 60.01*+ 59.95 " + , " 1920x1440 60.00 " + , " 1856x1392 60.01 " + , " 1792x1344 60.01 " + , " 2048x1152 60.00 59.90 59.91 " + , " 1920x1200 59.88 59.95 " + , " 1920x1080 59.96 60.00 59.93 " + , " 1600x1200 60.00 " + , " 1680x1050 59.95 59.88 " + , " 1400x1050 59.98 " + , " 1600x900 60.00 59.95 59.82 " + , " 1280x1024 60.02 " + , " 1400x900 59.96 59.88 " + , " 1280x960 60.00 " + , " 1368x768 60.00 59.88 59.85 " + , " 1280x800 59.81 59.91 " + , " 1280x720 59.86 60.00 59.74 " + , " 1024x768 60.00 " + , " 1024x576 60.00 59.90 59.82 " + , " 960x540 60.00 59.63 59.82 " + , " 800x600 60.32 56.25 " + , " 864x486 60.00 59.92 59.57 " + , " 640x480 59.94 " + , " 720x405 59.51 60.00 58.99 " + , " 640x360 59.84 59.32 60.00 " + , "DP1 disconnected (normal left inverted right x axis y axis)" + , "DP2 disconnected (normal left inverted right x axis y axis)" + , "DP2-1 disconnected (normal left inverted right x axis y axis)" + , "DP2-2 connected primary 2560x1440+0+0 (normal left inverted right x axis y axis) 600mm x 340mm" + , " 2560x1440 59.95*+" + , " 2048x1152 60.00 " + , " 1920x1200 59.88 " + , " 1920x1080 60.00 50.00 59.94 30.00 25.00 24.00 29.97 23.98 " + , " 1600x1200 60.00 " + , " 1680x1050 59.95 " + , " 1280x1024 75.02 60.02 " + , " 1200x960 59.99 " + , " 1152x864 75.00 " + , " 1280x720 60.00 50.00 59.94 " + , " 1024x768 75.03 60.00 " + , " 800x600 75.00 60.32 " + , " 720x576 50.00 " + , " 720x480 60.00 59.94 " + , " 640x480 75.00 60.00 59.94 " + , " 720x400 70.08 " + , "DP2-3 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)" + , "VIRTUAL1 disconnected (normal left inverted right x axis y axis)" + , "" + ] diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-}