module Test.Sandwich.WebDriver.Windows (
setWindowLeftSide
, setWindowRightSide
, setWindowFullScreen
, getScreenResolution
) where
import Control.Exception.Safe
import Control.Monad.IO.Class
import Control.Monad.Logger (MonadLogger)
import Control.Monad.Reader
import Data.Bits as B
import Data.Maybe
import GHC.Stack
import Test.Sandwich
import Test.Sandwich.WebDriver.Internal.Types
import Test.Sandwich.WebDriver.Resolution
import Test.WebDriver
import qualified Test.WebDriver.Class as W
setWindowLeftSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
setWindowLeftSide :: forall (wd :: * -> *) context.
(HasCallStack, MonadIO wd, WebDriverContext context wd,
MonadReader context wd, WebDriver wd, MonadLogger wd,
MonadMask wd) =>
wd ()
setWindowLeftSide = do
WebDriver
sess <- forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
MonadReader context m) =>
Label l a -> m a
getContext Label "webdriver" WebDriver
webdriver
(Int
x, Int
y, Int
width, Int
height) <- case WdOptions -> RunMode
runMode forall a b. (a -> b) -> a -> b
$ WebDriver -> WdOptions
wdOptions WebDriver
sess of
RunHeadless (HeadlessConfig {Maybe (Int, Int)
headlessResolution :: HeadlessConfig -> Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
..}) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
0, Int
w, Int
h)
where (Int
w, Int
h) = forall a. a -> Maybe a -> a
fromMaybe (Int
1920, Int
1080) Maybe (Int, Int)
headlessResolution
RunMode
_ -> forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadMask m, MonadLogger m) =>
WebDriver -> m (Int, Int, Int, Int)
getScreenResolution WebDriver
sess
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
setWindowPos (Int
x, Int
y)
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Word, Word) -> wd ()
setWindowSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
B.shift Int
width (-Int
1), forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
setWindowRightSide :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
setWindowRightSide :: forall (wd :: * -> *) context.
(HasCallStack, MonadIO wd, WebDriverContext context wd,
MonadReader context wd, WebDriver wd, MonadLogger wd,
MonadMask wd) =>
wd ()
setWindowRightSide = do
WebDriver
sess <- forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
MonadReader context m) =>
Label l a -> m a
getContext Label "webdriver" WebDriver
webdriver
(Int
x, Int
y, Int
width, Int
height) <- case WdOptions -> RunMode
runMode forall a b. (a -> b) -> a -> b
$ WebDriver -> WdOptions
wdOptions WebDriver
sess of
RunHeadless (HeadlessConfig {Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
headlessResolution :: HeadlessConfig -> Maybe (Int, Int)
..}) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
0, Int
w, Int
h)
where (Int
w, Int
h) = forall a. a -> Maybe a -> a
fromMaybe (Int
1920, Int
1080) Maybe (Int, Int)
headlessResolution
RunMode
_ -> forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadMask m, MonadLogger m) =>
WebDriver -> m (Int, Int, Int, Int)
getScreenResolution WebDriver
sess
let pos :: (Int, Int)
pos = (Int
x forall a. Num a => a -> a -> a
+ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
B.shift Int
width (-Int
1)), Int
y forall a. Num a => a -> a -> a
+ Int
0)
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
setWindowPos (Int, Int)
pos
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Word, Word) -> wd ()
setWindowSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
B.shift Int
width (-Int
1), forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
setWindowFullScreen :: (HasCallStack, MonadIO wd, WebDriverContext context wd, MonadReader context wd, W.WebDriver wd, MonadLogger wd, MonadMask wd) => wd ()
setWindowFullScreen :: forall (wd :: * -> *) context.
(HasCallStack, MonadIO wd, WebDriverContext context wd,
MonadReader context wd, WebDriver wd, MonadLogger wd,
MonadMask wd) =>
wd ()
setWindowFullScreen = do
WebDriver
sess <- forall (m :: * -> *) context (l :: Symbol) a.
(Monad m, HasLabel context l a, HasCallStack,
MonadReader context m) =>
Label l a -> m a
getContext Label "webdriver" WebDriver
webdriver
(Int
x, Int
y, Int
width, Int
height) <- case WdOptions -> RunMode
runMode forall a b. (a -> b) -> a -> b
$ WebDriver -> WdOptions
wdOptions WebDriver
sess of
RunHeadless (HeadlessConfig {Maybe (Int, Int)
headlessResolution :: Maybe (Int, Int)
headlessResolution :: HeadlessConfig -> Maybe (Int, Int)
..}) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Int
0, Int
0, Int
w, Int
h)
where (Int
w, Int
h) = forall a. a -> Maybe a -> a
fromMaybe (Int
1920, Int
1080) Maybe (Int, Int)
headlessResolution
RunMode
_ -> forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadMask m, MonadLogger m) =>
WebDriver -> m (Int, Int, Int, Int)
getScreenResolution WebDriver
sess
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Int, Int) -> wd ()
setWindowPos (Int
x forall a. Num a => a -> a -> a
+ Int
0, Int
y forall a. Num a => a -> a -> a
+ Int
0)
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
(Word, Word) -> wd ()
setWindowSize (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
width, forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
height)
getScreenResolution :: (HasCallStack, MonadIO m, MonadMask m, MonadLogger m) => WebDriver -> m (Int, Int, Int, Int)
getScreenResolution :: forall (m :: * -> *).
(HasCallStack, MonadIO m, MonadMask m, MonadLogger m) =>
WebDriver -> m (Int, Int, Int, Int)
getScreenResolution (WebDriver {wdWebDriver :: WebDriver
-> (Handle, Handle, ProcessHandle, FilePath, FilePath,
Maybe XvfbSession)
wdWebDriver=(Handle
_, Handle
_, ProcessHandle
_, FilePath
_, FilePath
_, Maybe XvfbSession
maybeXvfbSession)}) = case Maybe XvfbSession
maybeXvfbSession of
Maybe XvfbSession
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Int, Int, Int, Int)
getResolution
Just (XvfbSession {Int
FilePath
Maybe ProcessHandle
(Int, Int)
ProcessHandle
xvfbFluxboxProcess :: XvfbSession -> Maybe ProcessHandle
xvfbProcess :: XvfbSession -> ProcessHandle
xvfbDimensions :: XvfbSession -> (Int, Int)
xvfbXauthority :: XvfbSession -> FilePath
xvfbDisplayNum :: XvfbSession -> Int
xvfbFluxboxProcess :: Maybe ProcessHandle
xvfbProcess :: ProcessHandle
xvfbDimensions :: (Int, Int)
xvfbXauthority :: FilePath
xvfbDisplayNum :: Int
..}) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO (Int, Int, Int, Int)
getResolutionForDisplay Int
xvfbDisplayNum