Working on per-platform resolution call

sandwich-webdriver/package.yaml

@@ -46,7 +46,6 @@ dependencies:
 - unordered-containers
 - vector
 - webdriver
-- X11
 
 default-extensions:
 - OverloadedStrings
@@ -60,6 +59,8 @@ default-extensions:
 
 library:
   source-dirs: src
+  other-modules:
+    - Test.Sandwich.WebDriver.Resolution
   ghc-options:
   - -W
   # exposed-modules:
@@ -67,6 +68,16 @@ library:
   #   - Test.Sandwich.Webdriver.Video
   #   - Test.Sandwich.Webdriver.Windows
 
+when:
+  - condition: os(darwin)
+    source-dirs: darwin-src
+  - condition: os(windows)
+    source-dirs: windows-src
+  - condition: os(linux)
+    source-dirs: linux-src
+    dependencies:
+      - regex-compat
+
 executables:
   sandwich-webdriver-exe:
     main:                Main.hs

sandwich-webdriver/sandwich-webdriver.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 8968a701e022c6e6ffa78f1852882e8027de6f21adeeee0e2797554ec0c4645c
+-- hash: 75ad4e2b309491964b588fcd98c5beab0f01d58245b68890b7cd09816d206612
 
 name:           sandwich-webdriver
 version:        0.1.0.5
@@ -46,7 +46,7 @@ library
       Test.Sandwich.WebDriver.Video
       Test.Sandwich.WebDriver.Windows
   other-modules:
-      Paths_sandwich_webdriver
+      Test.Sandwich.WebDriver.Resolution
   hs-source-dirs:
       src
   default-extensions:
@@ -60,8 +60,7 @@ library
       LambdaCase
   ghc-options: -W
   build-depends:
-      X11
-    , aeson
+      aeson
     , base <5
     , containers
     , data-default
@@ -93,6 +92,17 @@ library
     , unordered-containers
     , vector
     , webdriver
+  if os(darwin)
+    hs-source-dirs:
+        darwin-src
+  if os(windows)
+    hs-source-dirs:
+        windows-src
+  if os(linux)
+    hs-source-dirs:
+        linux-src
+    build-depends:
+        regex-compat
   default-language: Haskell2010
 
 executable sandwich-webdriver-exe
@@ -113,8 +123,7 @@ executable sandwich-webdriver-exe
       LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      X11
-    , aeson
+      aeson
     , base <5
     , containers
     , data-default
@@ -147,6 +156,19 @@ executable sandwich-webdriver-exe
     , unordered-containers
     , vector
     , webdriver
+  if os(darwin)
+    hs-source-dirs:
+        darwin-src
+  if os(windows)
+    hs-source-dirs:
+        windows-src
+  if os(linux)
+    other-modules:
+        Test.Sandwich.WebDriver.Resolution
+    hs-source-dirs:
+        linux-src
+    build-depends:
+        regex-compat
   default-language: Haskell2010
 
 test-suite sandwich-webdriver-test
@@ -167,8 +189,7 @@ test-suite sandwich-webdriver-test
       LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      X11
-    , aeson
+      aeson
     , base <5
     , containers
     , data-default
@@ -201,4 +222,17 @@ test-suite sandwich-webdriver-test
     , unordered-containers
     , vector
     , webdriver
+  if os(darwin)
+    hs-source-dirs:
+        darwin-src
+  if os(windows)
+    hs-source-dirs:
+        windows-src
+  if os(linux)
+    other-modules:
+        Test.Sandwich.WebDriver.Resolution
+    hs-source-dirs:
+        linux-src
+    build-depends:
+        regex-compat
   default-language: Haskell2010

sandwich-webdriver/src/Test/Sandwich/WebDriver/Windows.hs

@@ -18,13 +18,10 @@ import Control.Monad.Logger (MonadLogger)
 import Control.Monad.Reader
 import Data.Bits as B
 import Data.Maybe
-import Data.String.Interpolate
 import GHC.Stack
-import qualified Graphics.X11.Xinerama as X
-import qualified Graphics.X11.Xlib.Display as X
-import Safe
 import Test.Sandwich
 import Test.Sandwich.WebDriver.Internal.Types
+import Test.Sandwich.WebDriver.Resolution
 import Test.WebDriver
 import qualified Test.WebDriver.Class as W
 
@@ -36,7 +33,7 @@ setWindowLeftSide = do
   (x, y, width, height) <- case runMode $ wdOptions sess of
     RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
       where (w, h) = fromMaybe (1920, 1080) headlessResolution
-    _ -> getScreenResolutionX11 sess
+    _ -> getScreenResolution sess
   setWindowPos (x + 0, y + 0)
   setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height)
 
@@ -47,7 +44,7 @@ setWindowRightSide = do
   (x, y, width, height) <- case runMode $ wdOptions sess of
     RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
       where (w, h) = fromMaybe (1920, 1080) headlessResolution
-    _ -> getScreenResolutionX11 sess
+    _ -> getScreenResolution sess
   let pos = (x + (fromIntegral $ B.shift width (-1)), y + 0)
   setWindowPos pos
   setWindowSize (fromIntegral $ B.shift width (-1), fromIntegral height)
@@ -59,31 +56,12 @@ setWindowFullScreen = do
   (x, y, width, height) <- case runMode $ wdOptions sess of
     RunHeadless (HeadlessConfig {..}) -> return (0, 0, w, h)
       where (w, h) = fromMaybe (1920, 1080) headlessResolution
-    _ -> getScreenResolutionX11 sess
+    _ -> getScreenResolution sess
   setWindowPos (x + 0, y + 0)
   setWindowSize (fromIntegral width, fromIntegral height)
 
 -- | Get the screen resolution as (x, y, width, height). (The x and y coordinates may be nonzero in multi-monitor setups.)
 getScreenResolution :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int)
-getScreenResolution = getScreenResolutionX11
-
--- * Internal
-
-getScreenResolutionX11 :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int)
-getScreenResolutionX11 (WebDriver {wdWebDriver=(_, _, _, _, _, maybeXvfbSession)}) = case maybeXvfbSession of
-    Nothing -> getScreenResolutionX11' ":0" 0
-    Just (XvfbSession {..}) -> getScreenResolutionX11' (":" <> show xvfbDisplayNum) 0
-
-getScreenResolutionX11' :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => String -> Int -> m (Int, Int, Int, Int)
-getScreenResolutionX11' displayString screenNumber = do
-  bracket (liftIO $ X.openDisplay displayString) (liftIO . X.closeDisplay) $ \display -> do
-    liftIO (X.xineramaQueryScreens display) >>= \case
-      Nothing -> do
-        -- TODO: this happens in CI when running under Xvfb. How to get resolution in that case?
-        logError [i|Couldn't query X11 for screens for display "#{display}"; using default resolution 1920x1080|]
-        return (0, 0, 1920, 1080)
-      Just infos -> do
-        case headMay [(xsi_x_org, xsi_y_org, xsi_width, xsi_height) | X.XineramaScreenInfo {..} <- infos
-                                                                    , xsi_screen_number == fromIntegral screenNumber] of
-          Nothing -> throwIO $ userError [i|Failed to get screen resolution (couldn't find screen number #{screenNumber})|]
-          Just (x, y, w, h) -> return (fromIntegral x, fromIntegral y, fromIntegral w, fromIntegral h)
+getScreenResolution (WebDriver {wdWebDriver=(_, _, _, _, _, maybeXvfbSession)}) = case maybeXvfbSession of
+    Nothing -> liftIO getResolution
+    Just (XvfbSession {..}) -> liftIO $ getResolutionForDisplay xvfbDisplayNum