packages feed

msu 0.0.2 → 0.2.0.0

raw patch · 17 files changed

+675/−209 lines, 17 filesdep +aesondep +aeson-casingdep +bytestringdep −mtldep −xdg-basedirdep ~basesetup-changed

Dependencies added: aeson, aeson-casing, bytestring, errors, hspec, msu, unliftio, yaml

Dependencies removed: mtl, xdg-basedir

Dependency ranges changed: base

Files

+ CHANGELOG.md view
@@ -0,0 +1,1 @@+# TODO
− MSU/Display.hs
@@ -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]-    }
− MSU/Hooks.hs
@@ -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
− MSU/Xrandr/Command.hs
@@ -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
− MSU/Xrandr/Parse.hs
@@ -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'
+ README.md view
@@ -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)
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
+ app/Main.hs view
@@ -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
− main.hs
@@ -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 ()
msu.cabal view
@@ -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 <pbrisbin@gmail.com>-maintainer:    Pat Brisbin <pbrisbin@gmail.com>-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 <pbrisbin@gmail.com>+maintainer:     Pat Brisbin <pbrisbin@gmail.com>+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
+ src/MSU/Context.hs view
@@ -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
+ src/MSU/Match.hs view
@@ -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)
+ src/MSU/Monitors.hs view
@@ -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]
+ src/MSU/Xrandr/Parse.hs view
@@ -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'
+ test/MSU/MonitorsSpec.hs view
@@ -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"+    ]
+ test/MSU/Xrandr/ParseSpec.hs view
@@ -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)"+    , ""+    ]
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}