{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE NumericUnderscores #-} module Spec.Actions where import Data.Aeson as A import Data.String.Interpolate import qualified Data.Text.Lazy.Encoding as TLE import System.FilePath import Test.Sandwich import Test.WebDriver import TestLib.Contexts.Session import TestLib.Contexts.StaticServer import TestLib.Mouse import TestLib.Types -- import Control.Monad.IO.Unlift -- import Control.Concurrent setUp :: ( HasStaticServerContext context, HasSession context ) => SpecFree context IO () -> SpecFree context IO () setUp x = before "Open test page" openSimpleTestPage $ before "scroll to clickable box" scrollToClickableBox x tests :: SessionSpec tests = introduceSession $ describe "Actions" $ setUp $ do it "moveToCenter" $ do Just dir <- getCurrentFolder saveScreenshot (dir "before.png") -- TODO: how to test this? Might need to detect mouseover events pending -- box <- findElem (ByCSS "#clickable-box") -- clickCenter box -- getBoundingClientRect "#clickable-box" >>= \bcr -> info [i|bcr: #{bcr}|] -- getLastMouseEvent >>= \lme -> info [i|lme: #{lme}|] it "clickCenter" $ do findElem (ByCSS "#clickable-box") >>= clickCenter center <- getElementCenter "#clickable-box" Just MouseEvent { eventType=MouseEventTypeClick, .. } <- getLastMouseEvent -- liftIO $ threadDelay 2_000_000 -- Just dir <- getCurrentFolder -- saveScreenshot (dir "click.png") -- ignoreReturn $ executeJS [] [i|document.querySelectorAll('div.magic').forEach(div => div.remove());|] -- liftIO $ threadDelay 2_000_000 assertWithinPixels center (fromIntegral clientX, fromIntegral clientY) 25 it "doubleClick" $ do findElem (ByCSS "#clickable-box") >>= doubleClickCenter -- liftIO $ threadDelay 2_000_000 -- Just dir <- getCurrentFolder -- saveScreenshot (dir "doubleclick.png") -- ignoreReturn $ executeJS [] [i|document.querySelectorAll('div.magic').forEach(div => div.remove());|] -- liftIO $ threadDelay 2_000_000 center <- getElementCenter "#clickable-box" Just MouseEvent { eventType=MouseEventTypeDoubleClick, .. } <- getLastMouseEvent assertWithinPixels center (fromIntegral clientX, fromIntegral clientY) 25 scrollToClickableBox :: (HasSession ctx) => ExampleT ctx IO () scrollToClickableBox = do -- { behavior: 'smooth', block: 'nearest', inline: 'nearest' } executeJS [] [i|document.querySelector("\#clickable-box").scrollIntoView()|] getLastMouseEvent :: (HasSession ctx) => ExampleT ctx IO (Maybe MouseEvent) getLastMouseEvent = do executeJS [] [i|return document.querySelector("\#last-mouse-event").innerText|] >>= \case "{}" -> return Nothing json -> case A.eitherDecode (TLE.encodeUtf8 json) of Left err -> expectationFailure [i|Failed to decode last mouse event: #{err}|] Right x -> pure x