webdriver-w3c 0.0.2 → 0.0.3

raw patch · 26 files changed

+1537/−705 lines, 26 filesdep ~basedep ~script-monadnew-component:exe:wd-repl-demoPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: base, script-monad

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +3/−1
• app/Main.lhs +10/−9
• app/ParallelStressTest.hs +1/−0
• app/ReplDemo.hs +143/−0
• app/TastyDemo.lhs +6/−6
• src/Test/Tasty/WebDriver.hs +66/−87
• src/Test/Tasty/WebDriver/Config.hs +37/−34
• src/Web/Api/WebDriver/Assert.hs +46/−41
• src/Web/Api/WebDriver/Endpoints.hs +192/−113
• src/Web/Api/WebDriver/Helpers.hs +12/−8
• src/Web/Api/WebDriver/Monad.hs +98/−79
• src/Web/Api/WebDriver/Types.hs +406/−78
• src/Web/Api/WebDriver/Uri.hs +13/−11
• test/Main.hs +0/−2
• test/Test/Tasty/WebDriver/Config/Test.hs +9/−5
• test/Web/Api/WebDriver/Assert/Test.hs +121/−56
• test/Web/Api/WebDriver/Monad/Test.hs +2/−6
• test/Web/Api/WebDriver/Monad/Test/Server.hs +83/−10
• test/Web/Api/WebDriver/Monad/Test/Server/Page.hs +7/−0
• test/Web/Api/WebDriver/Monad/Test/Server/State.hs +6/−5
• test/Web/Api/WebDriver/Monad/Test/Session/InvalidElementState.hs +6/−5
• test/Web/Api/WebDriver/Monad/Test/Session/Success.hs +203/−138
• test/Web/Api/WebDriver/Monad/Test/Session/UnknownError.hs +2/−4
• test/Web/Api/WebDriver/Types/Test.hs +26/−4
• webdriver-w3c.cabal +20/−3

@@ -1,6 +1,25 @@ Changelog for webdriver-w3c =========================== +Unreleased+----------++0.0.3+-----++* Added+  * `MonadIO` and `MonadFail` instances for `WebDriverTT t eff`+  * New endpoints: `newWindow`, `getComputedRole`, `getComputedLabel`, `printPage`+  * Compiles with aeson >=2.0.0.0 and GHC >=8.8.1+* Changed+  * The old behavior of `runIsolated` has been renamed to `runIsolated_`, and `runIsolated` now returns the result of its argument. The naming is meant to mimic the `sequence_`/`sequence` pattern.+  * `chromeOptions` renamed to `goog:chromeOptions` in `ToJSON` `FromJSON` instances for `Capability` for compatibility with chromedriver versions >=75; see https://chromedriver.storage.googleapis.com/75.0.3770.8/notes.txt. Fixes issue #21.+* Fixed+  * Bug in behavior of `switchToFrame` when using `FrameContainingElement`+  * Default value of wd-private-mode tasty flag changed to `False`+++ 0.0.2 ----- 

@@ -3,7 +3,7 @@  [![Build Status](https://travis-ci.org/nbloomf/webdriver-w3c.svg?branch=master)](https://travis-ci.org/nbloomf/webdriver-w3c) -Haskell bindings for the W3C WebDriver API+Haskell bindings for the W3C WebDriver API.   What is it?@@ -12,6 +12,8 @@ `webdriver-w3c` is a Haskell library providing bindings to the WebDriver API, enabling us to write Haskell programs that control web browsers. It is actively tested against `geckodriver` and `chromedriver`, as well as a fake remote end implementation. It is implemented as a monad transformer.  Also included is an integration with the [tasty](https://hackage.haskell.org/package/tasty) test framework.++Note that this library requires GHC >=8.6 due to a transitive dependency on `QuantifiedConstraints`.  [WebDriver](https://www.w3.org/TR/webdriver/) is an HTTP API for interacting with a web browser remotely. It is on track to become a W3C specification and based on work done by the [Selenium](https://www.seleniumhq.org/) community. 

@@ -85,13 +85,13 @@ > example1 :: IO () > example1 = do >   execWebDriverT defaultWebDriverConfig->     (runIsolated defaultFirefoxCapabilities do_a_barrel_roll)+>     (runIsolated_ defaultFirefoxCapabilities do_a_barrel_roll) >   return ()  Let's break down what just happened.  1. `do_a_barrel_roll` is a *WebDriver session*, expressed in the `WebDriver` DSL. It's a high-level description for a sequence of browser actions: in this case, "make the window full screen", "navigate to google.com", and so on.-2. `runIsolated` takes a WebDriver session and runs it in a fresh browser instance. The parameters of this instance are specified in `defaultFirefoxCapabilities`.+2. `runIsolated_` takes a WebDriver session and runs it in a fresh browser instance. The parameters of this instance are specified in `defaultFirefoxCapabilities`. 3. `execWebDriver` takes a WebDriver session and carries out the steps, using some options specified in `defaultWebDriverConfig`.  You probably also noticed a bunch of noise got printed to your terminal starting with something like this:@@ -160,9 +160,10 @@ by      defaultWebDriverConfig-      { _env = defaultWDEnv-        { _remotePort = 9515-        , _responseFormat = ChromeFormat+      { _environment = defaultWebDriverEnvironment+        { _env = defaultWDEnv+          { _remotePort = 9515+          }         }       } @@ -205,14 +206,14 @@ > example2 :: IO () > example2 = do >   (_, result) <- debugWebDriverT defaultWebDriverConfig->     (runIsolated defaultFirefoxCapabilities what_page_is_this)+>     (runIsolated_ defaultFirefoxCapabilities what_page_is_this) >   printSummary result >   return ()  Here's what happened:  1. `what_page_is_this` is a WebDriver session, just like `do_a_barrel_roll`, this time including an assertion: that the title of some web page is "Welcome to Lycos!".-2. `runIsolated` runs `what_page_is_this` in a fresh browser instance.+2. `runIsolated_` runs `what_page_is_this` in a fresh browser instance. 3. `debugWebDriver` works much like `execWebDriver`, except that it collects the results of any assertion statements and summarizes them (this is `result`). 4. `printSummary` takes the assertion results and prints them out all pretty like. @@ -373,7 +374,7 @@ > example4 t = do >   execReaderT (env t) $ >     execWebDriverTT defaultWebDriverConfig->       (runIsolated defaultFirefoxCapabilities custom_environment)+>       (runIsolated_ defaultFirefoxCapabilities custom_environment) >   return ()  Try it out with@@ -411,7 +412,7 @@ > example5 :: IO () > example5 = do >   execWebDriverT defaultWebDriverConfig->     (runIsolated defaultFirefoxCapabilities stop_and_smell_the_ajax)+>     (runIsolated_ defaultFirefoxCapabilities stop_and_smell_the_ajax) >   return ()  The basic `breakpoint` command gives the option to continue, throw an error, dump the current state and environment to stdout, and turn breakpoints off. A fancier version, `breakpointWith`, takes an additional argument letting us trigger a custom action.

@@ -2,6 +2,7 @@ This program is meant to simulate running a large number of tests in parallel. To set the number of tests to be run, export the WD_STRESS_TEST_NUM_TESTS variable in the shell. -} +{-# LANGUAGE OverloadedStrings #-} module Main where  import Test.Tasty

@@ -0,0 +1,143 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad.IO.Class+import Data.List (isInfixOf)+import Data.Text (Text)++import Web.Api.WebDriver++{-+Utilities for demoing webdriver sessions. I mostly use this for testing+and development. To run an individual demo, first make sure your remote end+(chromedriver or geckodriver) is running on the correct port, then from ghci+say something like:++    withChromedriver normalChrome demoNewWindow++The executable runs all the demos, although this is less useful.+-}++main :: IO ()+main = do+  withChromedriver normalChrome demoNewWindow+  withChromedriver normalChrome demoGetComputedRole+  withChromedriver normalChrome demoGetComputedLabel++  withChromedriver headlessChrome demoPrintPage++++++withChromedriver :: Capabilities -> WebDriverT IO () -> IO ()+withChromedriver caps acts = do+  execWebDriverT chromeConfig $+    runIsolated_ caps acts+  return ()++chromeConfig :: WebDriverConfig IO+chromeConfig = defaultWebDriverConfig+  { _environment = defaultWebDriverEnvironment+    { _env = defaultWDEnv+      { _remotePort = 9515+      , _responseFormat = SpecFormat+      }+    }+  }++normalChrome :: Capabilities+normalChrome = defaultChromeCapabilities++headlessChrome :: Capabilities+headlessChrome = defaultChromeCapabilities+  { _chromeOptions = Just $ defaultChromeOptions+    { _chromeArgs = Just ["--headless"]+    }+  }++consoleLogChrome :: Capabilities+consoleLogChrome = defaultChromeCapabilities+  { _chromeOptions = Just $ defaultChromeOptions+    { _chromeArgs = Just ["--user-data-dir=datadir", "--enable-logging", "--v=1"]+    }+  }++++demoNewWindow :: WebDriverT IO ()+demoNewWindow = do+  -- open google.com in the current tab+  navigateTo "https://www.google.com"++  -- open a new tab; but do not switch to it+  (handle, _) <- newWindow TabContext++  -- switch to the new tab+  switchToWindow handle++  -- open bing.com in this tab+  navigateTo "https://www.bing.com"++  wait 5000000+  return ()++++demoGetComputedRole :: WebDriverT IO ()+demoGetComputedRole = do+  -- open google.com+  navigateTo "https://www.google.com"++  -- get the ARIA role of whatever element is active on page load+  role <- getActiveElement >>= getComputedRole++  comment $ "Computed role is '" <> role <> "'"+  wait 5000000+  return ()++++demoGetComputedLabel :: WebDriverT IO ()+demoGetComputedLabel = do+  -- open google.com+  navigateTo "https://www.google.com"++  -- get the ARIA label of whatever element is active on page load+  role <- getActiveElement >>= getComputedLabel++  comment $ "Computed label is '" <> role <> "'"+  wait 5000000+  return ()++++demoPrintPage :: WebDriverT IO ()+demoPrintPage = do+  -- open google.com+  navigateTo "https://www.google.com"++  -- print+  pdf <- printPage defaultPrintOptions+  writeBase64EncodedPdf "testprint.pdf" pdf++  wait 5000000+  return ()++++-- use this to demonstrate getting the JS console log+--   withChromedriver consoleLogChrome demoConsoleLogChrome+demoConsoleLogChrome :: WebDriverT IO ()+demoConsoleLogChrome = do+  -- open google.com+  navigateTo "https://www.google.com"++  executeScript "console.error('HEYOOOO')" []++  -- logLines <- fmap lines $ liftIO $ readFile "~/datadir/chrome_debug.log" -- you'll need to expand ~ here+  -- let lines = filter ("CONSOLE" `isInfixOf`) logLines+  -- liftIO $ print lines++  wait 5000000+  return ()

@@ -89,7 +89,7 @@  `--wd-remote-ends` lets us supply the remote end URIs on the command line directly. Suppose I've got geckodriver listening on port 4444 and chromedriver on port 9515 (which they do by default). Then I'd use the following option: -    --wd-remote-ends 'geckodriver: https://localhost:4444 chromedriver: https://localhost:9515'+    --wd-remote-ends 'geckodriver https://localhost:4444 chromedriver https://localhost:9515'  (Note the explicit `https` scheme; this is required.) This is fine if you have a small number of remote ends running, but the command line quickly gets unwieldy if you have tens or hundreds of remote ends ready to run tests in parallel. So we can also specify the remote end URIs in a specially formatted config file. The config file must look something like this: @@ -106,7 +106,7 @@  `webdriver-w3c` can also run your tests in parallel. To take advantage of this, you'll need to compile your executable with `-threaded -rtsopts -with-rtsopts=-N` and start it with the `--num-threads N` option. You'll also need to start more than one remote end of each type. Note that if you want to run N tests in parallel, then you'll need N instances of _each_ remote end (geckodriver and chromedriver) running in the background. This is because the tests are _processed_ sequentially, even if they run in parallel. For instance, if you have 100 firefox tests followed by 100 chrome tests, but run them with one geckodriver and one chromedriver, the tests will run sequentially. -There are a bunch of other command line options for tweaking the behavior of your webdriver tests; use `wd-tasty-demo --help` to see a list. Most of these are pretty specialized. Other options are pretty common. In addition to `--wd-remote-ends` and `--wd-remote-ends-config`, there's `--wd-driver`, for specifying which driver to use, and `--wd-response-format`, which is required when using chromedriver because chromedriver is not fully spec compliant as of this writing.+There are a bunch of other command line options for tweaking the behavior of your webdriver tests; use `wd-tasty-demo --help` to see a list. Most of these are pretty specialized. Other options are pretty common. In addition to `--wd-remote-ends` and `--wd-remote-ends-config`, there's `--wd-driver`, for specifying which driver to use, and `--wd-response-format`, which was required when using old versions of chromedriver because it was not fully spec compliant.   Example sessions@@ -118,26 +118,26 @@  ``` geckodriver --port 4444 > /dev/null 2> /dev/null &-wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444'+wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' ```  Run one at a time with geckodriver, but can it with all the logs:  ``` geckodriver --port 4444 > /dev/null 2> /dev/null &-wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --wd-verbosity silent+wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --wd-verbosity silent ```  Run one at a time with chromedriver:  ``` chromedriver --port=9515 &-wd-tasty-demo --wd-driver chromedriver --wd-response-format chromedriver --wd-remote-ends 'chromedriver: https://localhost:9515'+wd-tasty-demo --wd-driver chromedriver --wd-remote-ends 'chromedriver https://localhost:9515' ```  Run two at a time with geckodriver:  ``` geckodriver --port 4444 > /dev/null 2> /dev/null &-wd-tasty-demo --wd-remote-ends 'geckodriver: https://localhost:4444' --num-threads 2+wd-tasty-demo --wd-remote-ends 'geckodriver https://localhost:4444' --num-threads 2 ```

@@ -10,7 +10,7 @@ Tasty integration for `WebDriverT` tests. -} -{-# LANGUAGE DeriveDataTypeable, RecordWildCards, Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, Rank2Types, OverloadedStrings #-} module Test.Tasty.WebDriver (     defaultWebDriverMain @@ -58,24 +58,18 @@   -import Control.Monad.IO.Class-  ( MonadIO, liftIO ) import Control.Monad.Trans.Class   ( MonadTrans(..) ) import Control.Monad.Trans.Identity   ( IdentityT(..) ) import Data.Typeable   ( Typeable, Proxy(Proxy) )-import Data.List-  ( unlines, lookup )-import qualified Data.HashMap.Strict as HM-  ( fromList ) import System.IO   ( Handle, stdout, stderr, stdin, openFile, IOMode(..), hClose ) import Control.Concurrent   ( threadDelay ) import Control.Concurrent.MVar-  ( MVar, newMVar, withMVar )+  ( newMVar ) import Control.Concurrent.STM    import Control.Lens@@ -84,14 +78,14 @@   ( pack ) import qualified Data.Digest.Pure.SHA as SHA   ( showDigest, sha1 )-import Data.IORef-  ( IORef, newIORef, atomicModifyIORef' ) import Data.Maybe   ( fromMaybe, catMaybes )-import Data.Time.Clock.System-  ( getSystemTime )+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.IO as Text+import Data.String import Network.HTTP.Client-  ( defaultManagerSettings, managerResponseTimeout, ResponseTimeout(..)+  ( defaultManagerSettings, managerResponseTimeout   , responseTimeoutNone ) import qualified Network.Wreq as Wreq   ( defaults, manager )@@ -103,76 +97,74 @@   ( readMaybe )  import qualified Data.Map.Strict as MS+import Data.Text (Text) import qualified Test.Tasty as T import qualified Test.Tasty.Providers as TT import qualified Test.Tasty.Options as TO-import qualified Test.Tasty.ExpectedFailure as TE-import qualified Test.Tasty.Ingredients.ConsoleReporter as TC -import Control.Monad.Script.Http (trivialLogOptions) import Web.Api.WebDriver import Test.Tasty.WebDriver.Config   -_OPT_LOG_HANDLE :: String+_OPT_LOG_HANDLE :: (IsString t) => t _OPT_LOG_HANDLE = "wd-log" -_OPT_CONSOLE_OUT :: String+_OPT_CONSOLE_OUT :: (IsString t) => t _OPT_CONSOLE_OUT = "wd-console-out" -_OPT_CONSOLE_IN :: String+_OPT_CONSOLE_IN :: (IsString t) => t _OPT_CONSOLE_IN = "wd-console-in" -_OPT_COLOR :: String+_OPT_COLOR :: (IsString t) => t _OPT_COLOR = "wd-color" -_OPT_HEADLESS :: String+_OPT_HEADLESS :: (IsString t) => t _OPT_HEADLESS = "wd-headless" -_OPT_DRIVER :: String+_OPT_DRIVER :: (IsString t) => t _OPT_DRIVER = "wd-driver" -_OPT_GECKODRIVER_LOG :: String+_OPT_GECKODRIVER_LOG :: (IsString t) => t _OPT_GECKODRIVER_LOG = "wd-geckodriver-log" -_OPT_BROWSERPATH :: String+_OPT_BROWSERPATH :: (IsString t) => t _OPT_BROWSERPATH = "wd-browserpath" -_OPT_DEPLOYMENT :: String+_OPT_DEPLOYMENT :: (IsString t) => t _OPT_DEPLOYMENT = "wd-deploy" -_OPT_REMOTE_ENDS :: String+_OPT_REMOTE_ENDS :: (IsString t) => t _OPT_REMOTE_ENDS = "wd-remote-ends" -_OPT_DATA_PATH :: String+_OPT_DATA_PATH :: (IsString t) => t _OPT_DATA_PATH = "wd-data-path" -_OPT_RESPONSE_FORMAT :: String+_OPT_RESPONSE_FORMAT :: (IsString t) => t _OPT_RESPONSE_FORMAT = "wd-response-format" -_OPT_API_VERSION :: String+_OPT_API_VERSION :: (IsString t) => t _OPT_API_VERSION = "wd-api-version" -_OPT_VERBOSITY :: String+_OPT_VERBOSITY :: (IsString t) => t _OPT_VERBOSITY = "wd-verbosity" -_OPT_NUM_RETRIES :: String+_OPT_NUM_RETRIES :: (IsString t) => t _OPT_NUM_RETRIES = "wd-num-retries" -_OPT_DELAY :: String+_OPT_DELAY :: (IsString t) => t _OPT_DELAY = "wd-delay" -_OPT_REMOTE_ENDS_CONFIG :: String+_OPT_REMOTE_ENDS_CONFIG :: (IsString t) => t _OPT_REMOTE_ENDS_CONFIG = "wd-remote-ends-config" -_OPT_PRIVATE_MODE :: String+_OPT_PRIVATE_MODE :: (IsString t) => t _OPT_PRIVATE_MODE = "wd-private-mode"    data WebDriverTest t eff = WebDriverTest-  { wdTestName :: String+  { wdTestName :: Text   , wdTestSession :: WebDriverTT t eff ()   , wdEval :: forall a. P WDAct a -> eff a   , wdToIO :: forall a. t eff a -> IO a@@ -219,7 +211,6 @@       BrowserPath browserPath = TO.lookupOption opts       RemoteEndRef remotes = TO.lookupOption opts       NumRetries numRetries = TO.lookupOption opts-      LogPrinterLock (Just logLock) = TO.lookupOption opts       LogColors logColors = TO.lookupOption opts       GeckodriverLog geckoLogLevel = TO.lookupOption opts       PrivateMode privateMode = TO.lookupOption opts@@ -227,7 +218,7 @@     let       title = comment wdTestName -      attemptLabel k = comment $ "Attempt #" ++ show k+      attemptLabel k = comment $ "Attempt #" <> Text.pack (show k)        logNoise = case logNoiseLevel of         NoisyLog -> False@@ -269,6 +260,8 @@         putStrLn "Error: no remote ends specified."         exitFailure +    logLock <- newMVar ()+     let       attempt :: Int -> IO TT.Result       attempt attemptNumber = do@@ -276,10 +269,10 @@         remote <- acquireRemoteEnd remotesRef delay driver          let-          uid = digest wdTestName ++ "-" ++ show attemptNumber ++ " " ++ show remote+          uid = digest wdTestName <> "-" <> Text.pack (show attemptNumber) <> " " <> Text.pack (show remote)             where-              digest :: (Show a) => a -> String-              digest = take 8 . SHA.showDigest . SHA.sha1 . BS.pack . show+              digest :: (Show a) => a -> Text+              digest = Text.pack . take 8 . SHA.showDigest . SHA.sha1 . BS.pack . show            config = WDConfig             { _evaluator = wdEval@@ -317,7 +310,7 @@             }          (result, summary) <- wdToIO $ debugWebDriverTT config $-            title >> attemptLabel attemptNumber >> runIsolated caps wdTestSession+            title >> attemptLabel attemptNumber >> runIsolated_ caps wdTestSession          atomically $ releaseRemoteEnd remotesRef driver remote @@ -325,7 +318,7 @@           Right _ ->             return $ webDriverAssertionsToResult summary           Left err -> if attemptNumber >= numRetries-            then return $ TT.testFailed $ "Unhandled error!\n" ++ err+            then return $ TT.testFailed $ Text.unpack $ "Unhandled error!\n" <> err             else attempt (attemptNumber + 1)      attempt 1@@ -335,7 +328,7 @@ webDriverAssertionsToResult :: AssertionSummary -> TT.Result webDriverAssertionsToResult x =   if numFailures x > 0-    then TT.testFailed $ unlines $ map printAssertion $ failures x+    then TT.testFailed $ unlines $ map (Text.unpack . printAssertion) $ failures x     else TT.testPassed $ show (numSuccesses x) ++ " assertion(s)"  @@ -399,8 +392,8 @@ testCaseWithSetupM   :: (Monad eff, Typeable eff)   => TT.TestName-  -> (forall u. P WDAct u -> eff u) -- ^ Evaluator-  -> (forall u. eff u -> IO u) -- ^ Conversion to `IO`+  -> (forall a. P WDAct a -> eff a) -- ^ Evaluator+  -> (forall a. eff a -> IO a) -- ^ Conversion to `IO`   -> WebDriverT eff u -- ^ Setup   -> (v -> WebDriverT eff ()) -- ^ Teardown   -> (u -> WebDriverT eff v) -- ^ The test@@ -434,7 +427,7 @@   -> TT.TestTree testCaseWithSetupTM name eval toIO setup teardown test =   TT.singleTest name WebDriverTest-    { wdTestName = name+    { wdTestName = Text.pack name     , wdTestSession = setup >>= test >>= teardown     , wdEval = eval     , wdToIO = toIO@@ -490,7 +483,7 @@   deriving Typeable  instance TO.IsOption PrivateMode where-  defaultValue = PrivateMode True+  defaultValue = PrivateMode False   parseValue = fmap PrivateMode . TO.safeReadBool   optionName = return _OPT_PRIVATE_MODE   optionHelp = return "run in private mode: (false), true"@@ -588,18 +581,6 @@   -newtype LogPrinterLock = LogPrinterLock-  { theLogPrinterLock :: Maybe (MVar ())-  } deriving Typeable--instance TO.IsOption LogPrinterLock where-  defaultValue = LogPrinterLock Nothing-  parseValue = error "LogPrinterLock is an internal option."-  optionName = error "LogPrinterLock is an internal option."-  optionHelp = error "LogPrinterLock is an internal option."--- -- | Log Noise Level. data LogNoiseLevel   = NoisyLog@@ -776,7 +757,6 @@ -- | Run a tree of WebDriverT tests. Thin wrapper around tasty's @defaultMain@ that attempts to determine the deployment tier and interprets remote end config command line options. defaultWebDriverMain :: TT.TestTree -> IO () defaultWebDriverMain tree = do-  logLock <- newMVar ()   pool <- getRemoteEndRef    -- Determine the deployment tier@@ -804,7 +784,6 @@   T.defaultMain     . T.localOption (Deployment deploy)     . T.localOption (RemoteEndRef $ Just pool)-    . T.localOption (LogPrinterLock $ Just logLock)     . T.localOption (LogHandle logHandle)     . T.localOption (LogColors colors)     . T.localOption (ConsoleOutHandle coutHandle)@@ -815,48 +794,48 @@     [ logHandle, coutHandle, cinHandle ]  -getWriteModeHandleOption :: String -> Handle -> IO Handle+getWriteModeHandleOption :: Text -> Handle -> IO Handle getWriteModeHandleOption opt theDefault = do-  args <- SE.getArgs-  case parseOptionWithArgument ("--" ++ opt) args of+  args <- fmap (fmap Text.pack) SE.getArgs+  case parseOptionWithArgument ("--" <> opt) args of     Nothing -> do-      putStrLn $ "Error: option '" ++ opt ++ "' is missing a required path argument"+      Text.putStrLn $ "Error: option '" <> opt <> "' is missing a required path argument"       exitFailure     Just Nothing -> return theDefault     Just (Just path) -> case path of       "stdout" -> return stdout       "stderr" -> return stderr-      _ -> openFile path WriteMode+      _ -> openFile (Text.unpack path) WriteMode  -getReadModeHandleOption :: String -> Handle -> IO Handle+getReadModeHandleOption :: Text -> Handle -> IO Handle getReadModeHandleOption opt theDefault = do-  args <- SE.getArgs-  case parseOptionWithArgument ("--" ++ opt) args of+  args <- fmap (fmap Text.pack) SE.getArgs+  case parseOptionWithArgument ("--" <> opt) args of     Nothing -> do-      putStrLn $ "Error: option '" ++ opt ++ "' is missing a required path argument"+      Text.putStrLn $ "Error: option '" <> opt <> "' is missing a required path argument"       exitFailure     Just Nothing -> return theDefault     Just (Just path) -> case path of       "stdin" -> return stdin-      _ -> openFile path ReadMode+      _ -> openFile (Text.unpack path) ReadMode   -- | Get the value of an option that can be controlled by either a command line flag or an environment variable, with the flag taking precedence. getEnvVarDefaultOption-  :: String -- ^ Flag name-  -> (String -> Maybe a) -- ^ Mapping flag values to option values-  -> String -- ^ Environment variable name-  -> (String -> Maybe a) -- ^ Mapping environment variable values to option values+  :: Text -- ^ Flag name+  -> (Text -> Maybe a) -- ^ Mapping flag values to option values+  -> Text -- ^ Environment variable name+  -> (Text -> Maybe a) -- ^ Mapping environment variable values to option values   -> a -- ^ Default option value (if neither flag nor env var is set)   -> IO a getEnvVarDefaultOption flag flagMap var varMap def = do   args <- SE.getArgs-  case parseOptionWithArgument ("--" ++ flag) args of+  case parseOptionWithArgument ("--" <> flag) (fmap Text.pack args) of      -- Flag is present, but with no argument given.     Nothing -> do-      putStrLn $ "Error: option '" ++ flag ++ "' is missing a required argument"+      Text.putStrLn $ "Error: option '" <> flag <> "' is missing a required argument"       exitFailure      -- Flag with argument is present.@@ -864,21 +843,21 @@       case flagMap value of         Just a -> return a         Nothing -> do-          putStrLn $ "Error: unrecognized value '" ++ value ++ "' for option '--" ++ flag ++ "'."+          Text.putStrLn $ "Error: unrecognized value '" <> value <> "' for option '--" <> flag <> "'."           exitFailure      -- Flag not present; try to use the environment variable.     Just Nothing -> do-      value <- SE.lookupEnv var-      case value of+      value <- SE.lookupEnv $ Text.unpack var+      case fmap Text.pack value of          -- Environment variable is set.         Just str ->           case varMap str of             Just a -> return a             Nothing -> do-              putStrLn $ "Error: unrecognized value '" ++ str ++-                "' for environment variable '" ++ var ++ "'."+              Text.putStrLn $ "Error: unrecognized value '" <> str <>+                "' for environment variable '" <> var <> "'."               exitFailure          -- Environment variable not set; use default.@@ -902,17 +881,17 @@  getRemoteEndConfigPath :: IO (Maybe RemoteEndPool) getRemoteEndConfigPath = do-  args <- SE.getArgs+  args <- fmap (fmap Text.pack) SE.getArgs   case parseOptionWithArgument "--wd-remote-ends-config" args of     Nothing -> do       putStrLn "option --wd-remote-ends-config missing required path argument"       exitFailure     Just Nothing -> return Nothing     Just (Just path) -> do-      str <- readFile path+      str <- Text.readFile $ Text.unpack path       case parseRemoteEndConfig str of         Left err -> do-          putStrLn err+          Text.putStrLn err           exitFailure         Right x -> return (Just x) @@ -920,7 +899,7 @@  getRemoteEndOptionString :: IO (Maybe RemoteEndPool) getRemoteEndOptionString = do-  args <- SE.getArgs+  args <- fmap (fmap Text.pack) SE.getArgs   case parseOptionWithArgument "--wd-remote-ends" args of     Nothing -> do       putStrLn "option --wd-remote-ends missing required argument"@@ -929,7 +908,7 @@     Just (Just str) ->       case parseRemoteEndOption str of         Left err -> do-          putStrLn err+          Text.putStrLn err           exitFailure         Right x -> return (Just x) 

@@ -8,7 +8,7 @@ Portability : POSIX -} -{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE RecordWildCards, OverloadedStrings #-} module Test.Tasty.WebDriver.Config (     DriverName(..)   , RemoteEndPool(..)@@ -25,11 +25,14 @@   ) where  import Data.List-  ( unlines, isPrefixOf, isSuffixOf, nub )+  ( isPrefixOf, nub ) import qualified Data.Map.Strict as MS   ( fromListWith, insert, lookup, adjust, fromList, unionWith, Map ) import Data.Typeable-  ( Typeable, Proxy(Proxy) )+  ( Typeable )+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T import Network.URI   ( URI(..), URIAuth(..), parseURI ) import Text.Read@@ -81,16 +84,16 @@  -- | Representation of a remote end connection. data RemoteEnd = RemoteEnd-  { remoteEndHost :: String -- ^ Scheme, auth, and hostname+  { remoteEndHost :: Text -- ^ Scheme, auth, and hostname   , remoteEndPort :: Int-  , remoteEndPath :: String -- ^ Additional path component+  , remoteEndPath :: Text -- ^ Additional path component   } deriving Eq  instance Show RemoteEnd where-  show remote = concat+  show remote = T.unpack $ T.concat     [ remoteEndHost remote     , ":"-    , show $ remoteEndPort remote+    , T.pack $ show $ remoteEndPort remote     , remoteEndPath remote     ] @@ -101,23 +104,23 @@ -- > - REMOTE_END_URI -- -- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme. Blank lines are ignored.-parseRemoteEndConfig :: String -> Either String RemoteEndPool+parseRemoteEndConfig :: Text -> Either Text RemoteEndPool parseRemoteEndConfig str = do-  freeEnds <- fmap (MS.fromListWith (++)) $ tokenizeRemoteEndConfig $ filter (/= "") $ lines str+  freeEnds <- fmap (MS.fromListWith (<>)) $ tokenizeRemoteEndConfig $ filter (/= "") $ T.lines str   return RemoteEndPool     { freeRemoteEnds = freeEnds     } -tokenizeRemoteEndConfig :: [String] -> Either String [(DriverName, [RemoteEnd])]+tokenizeRemoteEndConfig :: [Text] -> Either Text [(DriverName, [RemoteEnd])] tokenizeRemoteEndConfig ls = case ls of   [] -> return []   (first:rest) -> do     driver <- case first of       "geckodriver" -> return Geckodriver       "chromedriver" -> return Chromedriver-      _ -> Left $ "Unrecognized driver name '" ++ first ++ "'."-    let (remotes, remainder) = span ("- " `isPrefixOf`) rest-    ends <- mapM (parseRemoteEnd . drop 2) remotes+      _ -> Left $ "Unrecognized driver name '" <> first <> "'."+    let (remotes, remainder) = span ("- " `T.isPrefixOf`) rest+    ends <- mapM (parseRemoteEnd . T.drop 2) remotes     config <- tokenizeRemoteEndConfig remainder     return $ (driver, nub ends) : config @@ -126,57 +129,57 @@ -- > DRIVER_NAME: REMOTE_END_URI REMOTE_END_URI ... -- -- where `DRIVER_NAME` is either `geckodriver` or `chromedriver` and each `REMOTE_END_URI` is the uri of a WebDriver remote end, including scheme.-parseRemoteEndOption :: String -> Either String RemoteEndPool+parseRemoteEndOption :: Text -> Either Text RemoteEndPool parseRemoteEndOption str = do-  freeEnds <- fmap (MS.fromListWith (++)) $ tokenizeRemoteEndOption $ words str+  freeEnds <- fmap (MS.fromListWith (<>)) $ tokenizeRemoteEndOption $ T.words str   return RemoteEndPool     { freeRemoteEnds = freeEnds     } -tokenizeRemoteEndOption :: [String] -> Either String [(DriverName, [RemoteEnd])]+tokenizeRemoteEndOption :: [Text] -> Either Text [(DriverName, [RemoteEnd])] tokenizeRemoteEndOption ws = case ws of   [] -> return []   (first:rest) -> do     driver <- case first of       "geckodriver" -> return Geckodriver       "chromedriver" -> return Chromedriver-      _ -> Left $ "Unrecognized driver name '" ++ first ++ "'."+      _ -> Left $ "Unrecognized driver name '" <> first <> "'."     let (remotes, remainder) = break (`elem` ["geckodriver","chromedriver"]) rest     ends <- mapM parseRemoteEnd remotes     option <- tokenizeRemoteEndOption remainder     return $ (driver, nub ends) : option  -- | Parse a single remote end URI. Must include the scheme (http:// or https://) even though this is redundant.-parseRemoteEnd :: String -> Either String RemoteEnd-parseRemoteEnd str = case parseURI str of-  Nothing -> Left $ "Could not parse remote end URI '" ++ str ++ "'."+parseRemoteEnd :: Text -> Either Text RemoteEnd+parseRemoteEnd str = case parseURI $ T.unpack str of+  Nothing -> Left $ "Could not parse remote end URI '" <> str <> "'."   Just URI{..} -> case uriAuthority of-    Nothing -> Left $ "Error parsing authority for URI '" ++ str ++ "'."+    Nothing -> Left $ "Error parsing authority for URI '" <> str <> "'."     Just URIAuth{..} -> case uriPort of       "" -> Right RemoteEnd-        { remoteEndHost = uriUserInfo ++ uriRegName+        { remoteEndHost = T.pack $ uriUserInfo <> uriRegName         , remoteEndPort = 4444-        , remoteEndPath = uriPath+        , remoteEndPath = T.pack uriPath         }-      ':':ds -> case readMaybe ds of-        Nothing -> Left $ "Error parsing port for URI '" ++ str ++ "'."+      ':' : ds -> case readMaybe ds of+        Nothing -> Left $ "Error parsing port for URI '" <> str <> "'."         Just k -> Right RemoteEnd-          { remoteEndHost = uriUserInfo ++ uriRegName+          { remoteEndHost = T.pack $ uriUserInfo <> uriRegName           , remoteEndPort = k-          , remoteEndPath = uriPath+          , remoteEndPath = T.pack uriPath           }-      p -> Left $ "Unexpected port '" ++ p ++ "' in URI '" ++ str ++ "'."+      _ -> Left $ "Unexpected port '" <> T.pack uriPort <> "' in URI '" <> str <> "'."   -- | Helper function for parsing command line options with a required argument. Assumes long-form option names starting with a hyphen. Note the return type; @Just Nothing@ indicates that the option was not present, while @Nothing@ indicates that the option was present but its required argument was not. parseOptionWithArgument-  :: String -- ^ Option to parse for, including hyphen(s).-  -> [String] -- ^ List of command line arguments.-  -> Maybe (Maybe String)+  :: Text -- ^ Option to parse for, including hyphen(s).+  -> [Text] -- ^ List of command line arguments.+  -> Maybe (Maybe Text) parseOptionWithArgument option args = case args of   (opt:arg:rest) -> if opt == option-    then case arg of-      '-':_ -> Nothing-      _ -> Just (Just arg)+    then case T.uncons arg of+      Just (c,cs) -> if c == '-' then Nothing else Just (Just arg)+      Nothing -> Just (Just arg)     else parseOptionWithArgument option (arg:rest)   _ -> Just Nothing

@@ -30,6 +30,7 @@   , summarize   , summarizeAll   , printSummary+  , numAssertions    -- * Basic Assertions   , assertSuccessIf@@ -46,9 +47,12 @@   ) where  import Data.List-  ( unwords, isInfixOf )+  ( isInfixOf ) import Data.String   ( IsString, fromString )+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T import Test.QuickCheck   ( Arbitrary(..) ) @@ -72,33 +76,33 @@  -- | Human-readable statement which may be true or false. newtype AssertionStatement = AssertionStatement-  { theAssertionStatement :: String+  { theAssertionStatement :: Text   } deriving Eq  instance Show AssertionStatement where-  show = theAssertionStatement+  show = T.unpack . theAssertionStatement  instance IsString AssertionStatement where-  fromString = AssertionStatement+  fromString = AssertionStatement . T.pack  instance Arbitrary AssertionStatement where-  arbitrary = AssertionStatement <$> arbitrary+  arbitrary = AssertionStatement <$> (fmap T.pack arbitrary)    -- | Human-readable explanation for why an assertion is made. newtype AssertionComment = AssertionComment-  { theAssertionComment :: String+  { theAssertionComment :: Text   } deriving Eq  instance Show AssertionComment where-  show = theAssertionComment+  show = T.unpack . theAssertionComment  instance IsString AssertionComment where-  fromString = AssertionComment+  fromString = AssertionComment . T.pack  instance Arbitrary AssertionComment where-  arbitrary = AssertionComment <$> arbitrary+  arbitrary = AssertionComment <$> (fmap T.pack arbitrary)   @@ -119,20 +123,20 @@   -- | Basic string representation of an assertion.-printAssertion :: Assertion -> String+printAssertion :: Assertion -> Text printAssertion Assertion{..} =   case assertionResult of     AssertSuccess -> -      unwords+      T.unwords         [ "\x1b[1;32mValid Assertion\x1b[0;39;49m"-        , "\nassertion: " ++ show assertionStatement-        , "\ncomment: " ++ show assertionComment+        , "\nassertion: " <> theAssertionStatement assertionStatement+        , "\ncomment: " <> theAssertionComment assertionComment         ]     AssertFailure ->-      unwords+      T.unwords         [ "\x1b[1;31mInvalid Assertion\x1b[0;39;49m"-        , "\nassertion: " ++ show assertionStatement-        , "\ncomment: " ++ show assertionComment+        , "\nassertion: " <> theAssertionStatement assertionStatement+        , "\ncomment: " <> theAssertionComment assertionComment         ]  @@ -199,7 +203,7 @@   -> AssertionComment -- ^ An additional comment (the /why/)   -> m () assertTrue p = assertSuccessIf p-  (AssertionStatement $ show p ++ " is True")+  (AssertionStatement $ T.pack (show p) <> " is True")  -- | Succeeds if @Bool@ is `False`. assertFalse@@ -208,7 +212,7 @@   -> AssertionComment -- ^ An additional comment (the /why/)   -> m () assertFalse p = assertSuccessIf (not p)-  (AssertionStatement $ show p ++ " is False")+  (AssertionStatement $ T.pack (show p) <> " is False")  -- | Succeeds if the given @t@s are equal according to their `Eq` instance. assertEqual@@ -218,7 +222,8 @@   -> AssertionComment -- ^ An additional comment (the /why/)   -> m () assertEqual x y = assertSuccessIf (x == y)-  (AssertionStatement $ show x ++ " is equal to " ++ show y)+  (AssertionStatement $+    T.pack (show x) <> " is equal to " <> T.pack (show y))  -- | Succeeds if the given @t@s are not equal according to their `Eq` instance. assertNotEqual@@ -228,47 +233,47 @@   -> AssertionComment -- ^ An additional comment (the /why/)   -> m () assertNotEqual x y = assertSuccessIf (x /= y)-  (AssertionStatement $ show x ++ " is not equal to " ++ show y)+  (AssertionStatement $ T.pack (show x) <> " is not equal to " <> T.pack (show y))  -- | Succeeds if the first list is an infix of the second, according to their `Eq` instance. assertIsSubstring-  :: (Monad m, Assert m, Eq a, Show a)-  => [a]-  -> [a]+  :: (Monad m, Assert m)+  => Text+  -> Text   -> AssertionComment -- ^ An additional comment (the /why/)   -> m ()-assertIsSubstring x y = assertSuccessIf (x `isInfixOf` y)-  (AssertionStatement $ show x ++ " is a substring of " ++ show y)+assertIsSubstring x y = assertSuccessIf (T.isInfixOf x y)+  (AssertionStatement $ T.pack (show x) <> " is a substring of " <> T.pack (show y))  -- | Succeeds if the first list is not an infix of the second, according to their `Eq` instance. assertIsNotSubstring-  :: (Monad m, Assert m, Eq a, Show a)-  => [a]-  -> [a]+  :: (Monad m, Assert m)+  => Text+  -> Text   -> AssertionComment -- ^ An additional comment (the /why/)   -> m ()-assertIsNotSubstring x y = assertSuccessIf (not $ x `isInfixOf` y)-  (AssertionStatement $ show x ++ " is not a substring of " ++ show y)+assertIsNotSubstring x y = assertSuccessIf (not $ T.isInfixOf x y)+  (AssertionStatement $ T.pack (show x) <> " is not a substring of " <> T.pack (show y))  -- | Succeeds if the first list is an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage. assertIsNamedSubstring-  :: (Monad m, Assert m, Eq a, Show a)-  => [a]-  -> ([a],String)+  :: (Monad m, Assert m)+  => Text+  -> (Text,Text)   -> AssertionComment -- ^ An additional comment (the /why/)   -> m ()-assertIsNamedSubstring x (y,name) = assertSuccessIf (x `isInfixOf` y)-  (AssertionStatement $ show x ++ " is a substring of " ++ name)+assertIsNamedSubstring x (y,name) = assertSuccessIf (T.isInfixOf x y)+  (AssertionStatement $ T.pack (show x) <> " is a substring of " <> name)  -- | Succeeds if the first list is not an infix of the second, named list, according to their `Eq` instance. This is similar to `assertIsNotSubstring`, except that the "name" of the second list argument is used in reporting failures. Handy if the second list is very large -- say the source of a webpage. assertIsNotNamedSubstring-  :: (Monad m, Assert m, Eq a, Show a)-  => [a]-  -> ([a],String)+  :: (Monad m, Assert m)+  => Text+  -> (Text,Text)   -> AssertionComment -- ^ An additional comment (the /why/)   -> m ()-assertIsNotNamedSubstring x (y,name) = assertSuccessIf (not $ isInfixOf x y)-  (AssertionStatement $ show x ++ " is not a substring of " ++ name)+assertIsNotNamedSubstring x (y,name) = assertSuccessIf (not $ T.isInfixOf x y)+  (AssertionStatement $ T.pack (show x) <> " is not a substring of " <> name)   @@ -314,7 +319,7 @@ -- | Very basic string representation of an `AssertionSummary`. printSummary :: AssertionSummary -> IO () printSummary AssertionSummary{..} = do-  mapM_ (putStrLn . printAssertion) failures+  mapM_ (T.putStrLn . printAssertion) failures   putStrLn $ "Assertions: " ++ show (numSuccesses + numFailures)   putStrLn $ "Failures: " ++ show numFailures 

@@ -18,6 +18,7 @@ {-# LANGUAGE OverloadedStrings, BangPatterns #-} module Web.Api.WebDriver.Endpoints (     runIsolated+  , runIsolated_    -- * Sessions   -- ** New Session@@ -56,6 +57,8 @@   , switchToWindow   -- ** Get Window Handles   , getWindowHandles+  -- ** New Window+  , newWindow   -- ** Switch To Frame   , switchToFrame   -- ** Switch To Parent Frame@@ -100,6 +103,10 @@   , getElementRect   -- ** Is Element Enabled   , isElementEnabled+  -- ** Get Computed Role+  , getComputedRole+  -- ** Get Computed Label+  , getComputedLabel    -- * Element Interaction   -- ** Element Click@@ -153,6 +160,10 @@   -- ** Take Element Screenshot   , takeElementScreenshot +  -- * Print+  -- ** Print Page+  , printPage+   -- Spec Constants   , _WEB_ELEMENT_ID   , _WEB_WINDOW_ID@@ -164,11 +175,14 @@ import Data.Aeson   ( Value(..), encode, object, (.=), toJSON ) import Data.Text-  ( Text, unpack, pack )+  ( Text, unpack ) import Data.Text.Encoding   ( encodeUtf8 ) import qualified Data.ByteString as SB import qualified Data.ByteString.Base64 as B64+import Data.String (IsString)+import Data.Text (Text)+import qualified Data.Text as T import qualified Network.URI.Encode as E  import Web.Api.WebDriver.Types@@ -178,15 +192,15 @@   -- | Spec-defined "web element identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#elements>.-_WEB_ELEMENT_ID :: Text+_WEB_ELEMENT_ID :: (IsString t) => t _WEB_ELEMENT_ID = "element-6066-11e4-a52e-4f735466cecf"  -- | Spec-defined "web window identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#command-contexts>.-_WEB_WINDOW_ID :: Text+_WEB_WINDOW_ID :: (IsString t) => t _WEB_WINDOW_ID =  "window-fcc6-11e5-b4f8-330a88ab9d7f"  -- | Spec-defined "web frame identifier" string constant. See <https://w3c.github.io/webdriver/webdriver-spec.html#command-contexts>.-_WEB_FRAME_ID :: Text+_WEB_FRAME_ID :: (IsString t) => t _WEB_FRAME_ID = "frame-075b-4da1-b6ba-e579c2d3230a"  @@ -196,26 +210,26 @@ -- | Url of the remote WebDriver server. theRemoteUrl   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff String+  => WebDriverTT t eff Url theRemoteUrl = do   host <- fromEnv (_remoteHostname . _env)   port <- fromEnv (_remotePort . _env)   path <- fromEnv (_remotePath . _env)-  return $ concat [ "http://", host, ":", show port, path]+  return $ T.concat [ "http://", host, ":", T.pack $ show port, path]  -- | Url of the remote WebDriver server, with session ID.-theRemoteUrlWithSession :: (Monad eff, Monad (t eff), MonadTrans t) => WebDriverTT t eff String+theRemoteUrlWithSession :: (Monad eff, Monad (t eff), MonadTrans t) => WebDriverTT t eff Url theRemoteUrlWithSession = do   st <- fromState (_sessionId . _userState)   case st of     Nothing -> throwError NoSession     Just session_id -> do       baseUrl <- theRemoteUrl-      return $ concat [ baseUrl, "/session/", session_id ]+      return $ T.concat [ baseUrl, "/session/", session_id ]  -- | Set the session id of a `WDState`. setSessionId-  :: Maybe String+  :: Maybe Text   -> S WDState   -> S WDState setSessionId x st = st { _userState = (_userState st) { _sessionId = x } }@@ -236,18 +250,27 @@   :: (Monad eff, Monad (t eff), MonadTrans t)   => Capabilities   -> WebDriverTT t eff a-  -> WebDriverTT t eff ()+  -> WebDriverTT t eff a runIsolated caps theSession = cleanupOnError $ do   session_id <- newSession caps   modifyState $ setSessionId (Just session_id)-  theSession+  a <- theSession   deleteSession   modifyState $ setSessionId Nothing+  return a +runIsolated_+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => Capabilities+  -> WebDriverTT t eff a+  -> WebDriverTT t eff ()+runIsolated_ caps theSession =+  runIsolated caps theSession >> return ()    + -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#new-session>. For an extensible version allowing arbitrary changes to the JSON value representing the `Capabilities` parameter, see `newSession'`. newSession   :: (Monad eff, Monad (t eff), MonadTrans t)@@ -271,7 +294,7 @@         [ "alwaysMatch" .= toJSON caps ]       , "desiredCapabilities" .= toJSON caps       ]-  httpPost (baseUrl ++ "/session") payload+  httpPost (baseUrl <> "/session") payload     >>= (return . _responseBody)     >>= parseJson     >>= case format of@@ -279,7 +302,6 @@           ChromeFormat -> return     >>= lookupKeyJson "sessionId"     >>= constructFromJson-    >>= (return . unpack)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#delete-session>.@@ -299,11 +321,11 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#status>. sessionStatus   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff (Bool, String)+  => WebDriverTT t eff (Bool, Text) sessionStatus = do   baseUrl <- theRemoteUrl   format <- fromEnv (_responseFormat . _env)-  r <- httpGet (baseUrl ++ "/status")+  r <- httpGet (baseUrl <> "/status")     >>= (return . _responseBody)     >>= parseJson   ready <- case format of@@ -317,7 +339,6 @@       lookupKeyJson "value" r         >>= lookupKeyJson "message"         >>= constructFromJson-        >>= (return . unpack)     ChromeFormat -> return "chromedriver is not spec compliant :)"   return (ready, msg) @@ -328,7 +349,7 @@   => WebDriverTT t eff TimeoutConfig getTimeouts = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/timeouts")+  httpGet (baseUrl <> "/timeouts")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -343,7 +364,7 @@ setTimeouts timeouts = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode timeouts-  httpPost (baseUrl ++ "/timeouts") payload+  httpPost (baseUrl <> "/timeouts") payload   return ()  @@ -355,7 +376,7 @@ navigateTo url = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "url" .= url ]-  httpPost (baseUrl ++ "/url") payload+  httpPost (baseUrl <> "/url") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -371,7 +392,7 @@ navigateToStealth url = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "url" .= url ]-  httpSilentPost (baseUrl ++ "/url") payload+  httpSilentPost (baseUrl <> "/url") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -385,12 +406,11 @@   => WebDriverTT t eff Url getCurrentUrl = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/url")+  httpGet (baseUrl <> "/url")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson-    >>= (return . unpack)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#back>.@@ -400,7 +420,7 @@ goBack = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/back") payload+  httpPost (baseUrl <> "/back") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -415,7 +435,7 @@ goForward = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/forward") payload+  httpPost (baseUrl <> "/forward") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -430,7 +450,7 @@ pageRefresh = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/refresh") payload+  httpPost (baseUrl <> "/refresh") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -441,15 +461,14 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-title>. getTitle   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff String+  => WebDriverTT t eff Text getTitle = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/title")+  httpGet (baseUrl <> "/title")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson-    >>= (return . unpack)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-window-handle>.@@ -458,12 +477,12 @@   => WebDriverTT t eff ContextId getWindowHandle = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/window")+  httpGet (baseUrl <> "/window")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson-    >>= (return . ContextId . unpack)+    >>= (return . ContextId)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#close-window>.@@ -472,13 +491,13 @@   => WebDriverTT t eff [ContextId] closeWindow = do   baseUrl <- theRemoteUrlWithSession-  httpDelete (baseUrl ++ "/window")+  httpDelete (baseUrl <> "/window")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson     >>= (sequence . map constructFromJson)-    >>= (return . map (ContextId . unpack))+    >>= (return . map ContextId)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-window>.@@ -490,7 +509,7 @@   let contextId = contextIdOf t   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object [ "handle" .= show contextId ]-  httpPost (baseUrl ++ "/window") payload+  httpPost (baseUrl <> "/window") payload   return ()  @@ -500,15 +519,33 @@   => WebDriverTT t eff [ContextId] getWindowHandles = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/window/handles")+  httpGet (baseUrl <> "/window/handles")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson     >>= (sequence . map constructFromJson)-    >>= (return . map (ContextId . unpack))+    >>= (return . map ContextId)  +-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#new-window>+newWindow+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => ContextType -> WebDriverTT t eff (ContextId, ContextType)+newWindow ctxTypeReq = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "type" .= ctxTypeReq ]+  response <- httpPost (baseUrl <> "/window/new") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+  ctxId <- lookupKeyJson "handle" response+    >>= constructFromJson+  ctxType <- lookupKeyJson "type" response+    >>= constructFromJson+  return (ctxId, ctxType)++ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-frame>. switchToFrame   :: (Monad eff, Monad (t eff), MonadTrans t)@@ -520,12 +557,12 @@     !frame = case ref of       TopLevelFrame -> Null       FrameNumber k -> Number $ fromIntegral k-      FrameContainingElement element_id -> String $ pack $ show element_id+      FrameContainingElement element_id -> object [ _WEB_ELEMENT_ID .= show element_id ]      !payload = encode $ object       [ "id" .= toJSON frame ] -  httpPost (baseUrl ++ "/frame") payload+  httpPost (baseUrl <> "/frame") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -540,7 +577,7 @@ switchToParentFrame = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/frame/parent") payload+  httpPost (baseUrl <> "/frame/parent") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -554,7 +591,7 @@   => WebDriverTT t eff Rect getWindowRect = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/window/rect")+  httpGet (baseUrl <> "/window/rect")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -569,7 +606,7 @@ setWindowRect rect = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode rect-  httpPost (baseUrl ++ "/window/rect") payload+  httpPost (baseUrl <> "/window/rect") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -583,7 +620,7 @@ maximizeWindow = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object []-  httpPost (baseUrl ++ "/window/maximize") payload+  httpPost (baseUrl <> "/window/maximize") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -597,7 +634,7 @@ minimizeWindow = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object []-  httpPost (baseUrl ++ "/window/minimize") payload+  httpPost (baseUrl <> "/window/minimize") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -611,7 +648,7 @@ fullscreenWindow = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object []-  httpPost (baseUrl ++ "/window/fullscreen") payload+  httpPost (baseUrl <> "/window/fullscreen") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -627,7 +664,7 @@ findElement strategy selector = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]-  httpPost (baseUrl ++ "/element") payload+  httpPost (baseUrl <> "/element") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -635,7 +672,7 @@           SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID           ChromeFormat -> lookupKeyJson "ELEMENT"     >>= constructFromJson-    >>= (return . ElementRef . unpack)+    >>= (return . ElementRef)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-elements>.@@ -647,7 +684,7 @@ findElements strategy selector = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]-  httpPost (baseUrl ++ "/elements") payload+  httpPost (baseUrl <> "/elements") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -656,7 +693,7 @@           SpecFormat -> mapM (lookupKeyJson _WEB_ELEMENT_ID)           ChromeFormat -> mapM (lookupKeyJson "ELEMENT")     >>= mapM constructFromJson-    >>= (return . map (ElementRef . unpack))+    >>= (return . map ElementRef)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-element-from-element>.@@ -668,9 +705,9 @@   -> WebDriverTT t eff ElementRef findElementFromElement strategy selector root = do   (baseUrl, format) <- theRequestContext-  let root_id = elementRefOf root+  let root_id = theElementRef $ elementRefOf root   let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]-  httpPost (baseUrl ++ "/element/" ++ show root_id ++ "/element") payload+  httpPost (baseUrl <> "/element/" <> root_id <> "/element") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -678,7 +715,7 @@           SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID           ChromeFormat -> lookupKeyJson "ELEMENT"     >>= constructFromJson-    >>= (return . ElementRef . unpack)+    >>= (return . ElementRef)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#find-elements-from-element>.@@ -690,9 +727,9 @@   -> WebDriverTT t eff [ElementRef] findElementsFromElement strategy selector root = do   (baseUrl, format) <- theRequestContext-  let root_id = elementRefOf root+  let root_id = theElementRef $ elementRefOf root   let !payload = encode $ object [ "value" .= selector, "using" .= toJSON strategy ]-  httpPost (baseUrl ++ "/element/" ++ show root_id ++ "/elements") payload+  httpPost (baseUrl <> "/element/" <> root_id <> "/elements") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -701,7 +738,7 @@           SpecFormat -> mapM (lookupKeyJson _WEB_ELEMENT_ID)           ChromeFormat -> mapM (lookupKeyJson "ELEMENT")     >>= mapM constructFromJson-    >>= (return . map (ElementRef . unpack))+    >>= (return . map ElementRef)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-active-element>.@@ -710,7 +747,7 @@   => WebDriverTT t eff ElementRef getActiveElement = do   (baseUrl, format) <- theRequestContext-  httpGet (baseUrl ++ "/element/active")+  httpGet (baseUrl <> "/element/active")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -718,7 +755,7 @@           SpecFormat -> lookupKeyJson _WEB_ELEMENT_ID           ChromeFormat -> lookupKeyJson "ELEMENT"     >>= constructFromJson-    >>= (return . ElementRef . unpack)+    >>= (return . ElementRef)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#is-element-selected>.@@ -727,9 +764,9 @@   => a   -> WebDriverTT t eff Bool isElementSelected element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/selected")+  httpGet (baseUrl <> "/element/" <> elementRef <> "/selected")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -741,18 +778,18 @@   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)   => AttributeName   -> a-  -> WebDriverTT t eff (Either Bool String)+  -> WebDriverTT t eff (Either Bool Text) getElementAttribute name element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  x <- httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/attribute/" ++ E.encode name)+  x <- httpGet (baseUrl <> "/element/" <> elementRef <> "/attribute/" <> E.encodeText name)     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"   case x of     Null -> return (Left False)     String "true" -> return (Left True)-    String attr -> return (Right $ unpack attr)+    String attr -> return (Right attr)     _ -> throwJsonError $ JsonError "Invalid element attribute response"  @@ -763,9 +800,9 @@   -> a   -> WebDriverTT t eff Value getElementProperty name element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/property/" ++ E.encode name)+  httpGet (baseUrl <> "/element/" <> elementRef <> "/property/" <> E.encodeText name)     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -776,11 +813,11 @@   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)   => CssPropertyName   -> a-  -> WebDriverTT t eff String+  -> WebDriverTT t eff Text getElementCssValue name element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/css/" ++ name)+  httpGet (baseUrl <> "/element/" <> elementRef <> "/css/" <> name)     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -791,11 +828,11 @@ getElementText   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)   => a-  -> WebDriverTT t eff String+  -> WebDriverTT t eff Text getElementText element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/text")+  httpGet (baseUrl <> "/element/" <> elementRef <> "/text")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -806,11 +843,11 @@ getElementTagName   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)   => a-  -> WebDriverTT t eff String+  -> WebDriverTT t eff Text getElementTagName element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/name")+  httpGet (baseUrl <> "/element/" <> elementRef <> "/name")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -823,9 +860,9 @@   => a   -> WebDriverTT t eff Rect getElementRect element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/rect")+  httpGet (baseUrl <> "/element/" <> elementRef <> "/rect")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -838,15 +875,45 @@   => a   -> WebDriverTT t eff Bool isElementEnabled element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/enabled")+  httpGet (baseUrl <> "/element/" <> elementRef <> "/enabled")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson  +-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-computed-role>+getComputedRole+  :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)+  => a+  -> WebDriverTT t eff AriaRole+getComputedRole element = do+  let elementRef = theElementRef $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl <> "/element/" <> elementRef <> "/computedrole")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson+++-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-computed-label>+getComputedLabel+  :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)+  => a+  -> WebDriverTT t eff AriaLabel+getComputedLabel element = do+  let elementRef = theElementRef $ elementRefOf element+  baseUrl <- theRemoteUrlWithSession+  httpGet (baseUrl <> "/element/" <> elementRef <> "/computedlabel")+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson++ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#element-click>. elementClick   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)@@ -854,9 +921,9 @@   -> WebDriverTT t eff () elementClick element = do   (baseUrl, format) <- theRequestContext-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   let !payload = encode $ object []-  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/click") payload+  httpPost (baseUrl <> "/element/" <> elementRef <> "/click") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -871,9 +938,9 @@   -> WebDriverTT t eff () elementClear element = do   (baseUrl, format) <- theRequestContext-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   let !payload = encode $ object []-  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/clear") payload+  httpPost (baseUrl <> "/element/" <> elementRef <> "/clear") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -884,14 +951,14 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#element-send-keys>. elementSendKeys   :: (Monad eff, Monad (t eff), MonadTrans t, HasElementRef a)-  => String+  => Text   -> a   -> WebDriverTT t eff () elementSendKeys text element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "text" .= text ]-  httpPost (baseUrl ++ "/element/" ++ elementRef ++ "/value") payload+  httpPost (baseUrl <> "/element/" <> elementRef <> "/value") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -902,29 +969,27 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-page-source>. getPageSource   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff String+  => WebDriverTT t eff Text getPageSource = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/source")+  httpGet (baseUrl <> "/source")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson-    >>= (return . unpack)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-page-source>. Does not dump the page source into the logs. :) getPageSourceStealth   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff String+  => WebDriverTT t eff Text getPageSourceStealth = do   baseUrl <- theRemoteUrlWithSession-  httpSilentGet (baseUrl ++ "/source")+  httpSilentGet (baseUrl <> "/source")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"     >>= constructFromJson-    >>= (return . unpack)   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#execute-script>.@@ -936,7 +1001,7 @@ executeScript script args = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object [ "script" .= script, "args" .= toJSON args ]-  httpPost (baseUrl ++ "/execute/sync") payload+  httpPost (baseUrl <> "/execute/sync") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -951,7 +1016,7 @@ executeAsyncScript script args = do   baseUrl <- theRemoteUrlWithSession   let !payload = encode $ object [ "script" .= script, "args" .= toJSON args ]-  httpPost (baseUrl ++ "/execute/async") payload+  httpPost (baseUrl <> "/execute/async") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -963,7 +1028,7 @@   => WebDriverTT t eff [Cookie] getAllCookies = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/cookie")+  httpGet (baseUrl <> "/cookie")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -978,7 +1043,7 @@   -> WebDriverTT t eff Cookie getNamedCookie name = do   baseUrl <- theRemoteUrlWithSession-  httpGet (baseUrl ++ "/cookie/" ++ E.encode name)+  httpGet (baseUrl <> "/cookie/" <> T.pack (E.encode $ unpack name))     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -990,10 +1055,10 @@   :: (Monad eff, Monad (t eff), MonadTrans t)   => Cookie   -> WebDriverTT t eff ()-addCookie cookie = do+addCookie c = do   (baseUrl, format) <- theRequestContext-  let !payload = encode $ object [ "cookie" .= cookie ]-  httpSilentPost (baseUrl ++ "/cookie") payload+  let !payload = encode $ object [ "cookie" .= c ]+  httpSilentPost (baseUrl <> "/cookie") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1008,7 +1073,7 @@   -> WebDriverTT t eff () deleteCookie name = do   (baseUrl, format) <- theRequestContext-  httpDelete (baseUrl ++ "/cookie/" ++ E.encode name)+  httpDelete (baseUrl <> "/cookie/" <> T.pack (E.encode $ unpack name))     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1022,7 +1087,7 @@   => WebDriverTT t eff () deleteAllCookies = do   (baseUrl, format) <- theRequestContext-  httpDelete (baseUrl ++ "/cookie")+  httpDelete (baseUrl <> "/cookie")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1055,7 +1120,7 @@   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "actions" .= toJSON action ]   let httpMethod = if stealth then httpSilentPost else httpPost-  httpMethod (baseUrl ++ "/actions") payload+  httpMethod (baseUrl <> "/actions") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1069,7 +1134,7 @@   => WebDriverTT t eff () releaseActions = do   baseUrl <- theRemoteUrlWithSession-  httpDelete (baseUrl ++ "/actions")+  httpDelete (baseUrl <> "/actions")   return ()  @@ -1080,7 +1145,7 @@ dismissAlert = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/alert/dismiss") payload+  httpPost (baseUrl <> "/alert/dismiss") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1095,7 +1160,7 @@ acceptAlert = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object []-  httpPost (baseUrl ++ "/alert/accept") payload+  httpPost (baseUrl <> "/alert/accept") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1106,28 +1171,28 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#get-alert-text>. getAlertText   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff (Maybe String)+  => WebDriverTT t eff (Maybe Text) getAlertText = do   baseUrl <- theRemoteUrlWithSession-  msg <- httpGet (baseUrl ++ "/alert/text")+  msg <- httpGet (baseUrl <> "/alert/text")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"   case msg of     Null -> return Nothing-    String text -> return $ Just (unpack text)+    String text -> return $ Just text     _ -> throwJsonError $ JsonError "Invalid alert text response"   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#send-alert-text>. sendAlertText   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String+  => Text   -> WebDriverTT t eff () sendAlertText msg = do   (baseUrl, format) <- theRequestContext   let !payload = encode $ object [ "text" .= msg ]-  httpPost (baseUrl ++ "/alert/text") payload+  httpPost (baseUrl <> "/alert/text") payload     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1141,7 +1206,7 @@   => WebDriverTT t eff SB.ByteString takeScreenshot = do   baseUrl <- theRemoteUrlWithSession-  result <- httpGet (baseUrl ++ "/screenshot")+  result <- httpGet (baseUrl <> "/screenshot")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1149,7 +1214,7 @@     >>= (return . B64.decode . encodeUtf8)   case result of     Right img -> return img-    Left str -> throwError $ ImageDecodeError str+    Left str -> throwError $ ImageDecodeError $ T.pack str   -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#take-element-screenshot>.@@ -1158,9 +1223,9 @@   => a   -> WebDriverTT t eff SB.ByteString takeElementScreenshot element = do-  let elementRef = show $ elementRefOf element+  let elementRef = theElementRef $ elementRefOf element   baseUrl <- theRemoteUrlWithSession-  result <- httpGet (baseUrl ++ "/element/" ++ elementRef ++ "/screenshot")+  result <- httpGet (baseUrl <> "/element/" <> elementRef <> "/screenshot")     >>= (return . _responseBody)     >>= parseJson     >>= lookupKeyJson "value"@@ -1168,9 +1233,23 @@     >>= (return . B64.decode . encodeUtf8)   case result of     Right img -> return img-    Left str -> throwError $ ImageDecodeError str+    Left str -> throwError $ ImageDecodeError $ T.pack str  +-- | See <https://w3c.github.io/webdriver/webdriver-spec.html#print-page>. You may also be interested in `decodeBase64EncodedPdf` and `writeBase64EncodedPdf`.+printPage+  :: (Monad eff, Monad (t eff), MonadTrans t)+  => PrintOptions -> WebDriverTT t eff Base64EncodedPdf+printPage opts = do+  baseUrl <- theRemoteUrlWithSession+  let !payload = encode $ object [ "parameters" .= opts ]+  httpPost (baseUrl <> "/print") payload+    >>= (return . _responseBody)+    >>= parseJson+    >>= lookupKeyJson "value"+    >>= constructFromJson++ -- | Detect empty responses by response format. Necessary because chromedriver is not strictly spec compliant. expectEmptyObject   :: (Monad eff, Monad (t eff), MonadTrans t)@@ -1184,7 +1263,7 @@  theRequestContext   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff (String, ResponseFormat)+  => WebDriverTT t eff (Url, ResponseFormat) theRequestContext = do   baseUrl <- theRemoteUrlWithSession   format <- fromEnv (_responseFormat . _env)

@@ -8,6 +8,7 @@ Portability : POSIX -} +{-# LANGUAGE OverloadedStrings #-} module Web.Api.WebDriver.Helpers (   -- * Data     writeDataFile@@ -29,11 +30,14 @@ import qualified Data.Aeson as Aeson   ( encode, ToJSON(..), Value ) import Data.ByteString.Lazy-  ( ByteString )+  ( ByteString, fromChunks ) import qualified Data.ByteString.Lazy.Char8 as BS   ( pack ) import qualified Data.Digest.Pure.SHA as SHA   ( showDigest, sha1 )+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.Encoding as T  import Web.Api.WebDriver.Endpoints import Web.Api.WebDriver.Monad@@ -47,20 +51,20 @@ -- | Save all cookies for the current domain to a file. stashCookies   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -- ^ Passed through SHA1, and the digest is used as the filename.+  => Text -- ^ Passed through SHA1, and the digest is used as the filename.   -> WebDriverTT t eff () stashCookies string =-  let file = SHA.showDigest $ SHA.sha1 $ BS.pack string in+  let file = SHA.showDigest $ SHA.sha1 $ fromChunks [T.encodeUtf8 string] in   getAllCookies >>= writeCookieFile file   -- | Load cookies from a file saved with `stashCookies`. Returns `False` if the cookie file is missing or cannot be read. loadCookies   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -- ^ Passed through SHA1, and the digest is used as the filename.+  => Text -- ^ Passed through SHA1, and the digest is used as the filename.   -> WebDriverTT t eff Bool loadCookies string = do-  let file = SHA.showDigest $ SHA.sha1 $ BS.pack string+  let file = SHA.showDigest $ SHA.sha1 $ fromChunks [T.encodeUtf8 string]   contents <- readCookieFile file   case contents of     Nothing -> return False@@ -146,7 +150,7 @@ keypress :: Char -> ActionItem keypress x = emptyActionItem   { _actionType = Just KeyDownAction-  , _actionValue = Just [x]+  , _actionValue = Just $ T.singleton x   }  @@ -160,9 +164,9 @@   -- | Simulate typing some text.-typeString :: String -> Action+typeString :: Text -> Action typeString x = emptyAction   { _inputSourceType = Just KeyInputSource   , _inputSourceId = Just "kbd"-  , _actionItems = map keypress x+  , _actionItems = map keypress $ T.unpack x   }

@@ -12,6 +12,7 @@  {-#   LANGUAGE+    CPP,     GADTs,     Rank2Types,     KindSignatures,@@ -87,7 +88,7 @@   , breakpointWith    -- * Types-  , Http.E(..)+  , Http.E()   , Http.JsonError(..)   , WDError(..)   , Http.R(..)@@ -114,7 +115,11 @@   +#if MIN_VERSION_base(4,9,0)+import Prelude hiding (fail, readFile, writeFile, putStrLn)+#else import Prelude hiding (readFile, writeFile, putStrLn)+#endif  import Control.Concurrent.MVar   ( MVar )@@ -124,6 +129,8 @@   ( (^.), (^?) ) import Control.Monad   ( ap )+import Control.Monad.IO.Class+  ( MonadIO(..) ) import Control.Monad.Trans.Class   ( MonadTrans(..) ) import Control.Monad.Trans.Identity@@ -137,19 +144,16 @@ import qualified Data.ByteString.Char8 as SC   ( unpack ) import Data.ByteString.Lazy-  ( ByteString, readFile, writeFile )+  ( ByteString, readFile, writeFile, toStrict, fromStrict ) import qualified Data.ByteString.Lazy.Char8 as LC   ( unpack, pack )-import Data.Functor.Identity-  ( Identity(..) )-import Data.IORef-  ( IORef, newIORef, readIORef, writeIORef ) import Data.List   ( intercalate )-import qualified Data.Map.Strict as M-  ( Map, fromList ) import Data.Text-  ( pack, unpack, Text )+  ( unpack, Text )+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Encoding as T import qualified Network.HTTP.Client as N   ( HttpException(..), HttpExceptionContent(..) ) import Network.Wreq@@ -157,12 +161,17 @@ import System.Directory   ( doesFileExist ) import System.IO-  ( Handle, hGetLine, hSetEcho, hGetEcho, hFlush, stdout, stdin )+  ( Handle, hGetLine, hSetEcho, hGetEcho, stdout, stdin ) import System.IO.Error   ( eofErrorType, doesNotExistErrorType, mkIOError ) import Test.QuickCheck   ( Property ) +-- Transitional MonadFail implementation+#if MIN_VERSION_base(4,9,0)+import Control.Monad.Fail+#endif+ import qualified Control.Monad.Script.Http as Http import qualified Data.MockIO as Mock import qualified Data.MockIO.FileSystem as FS@@ -199,6 +208,16 @@   return = WDT . return   (WDT x) >>= f = WDT (x >>= (unWDT . f)) +instance+  (MonadIO eff, MonadIO (t eff), MonadTrans t)+    => MonadIO (WebDriverTT t eff) where+  liftIO = WDT . Http.liftHttpTT . liftIO++instance+  (Monad eff, MonadTrans t, Monad (t eff), MonadFail (t eff))+    => MonadFail (WebDriverTT t eff) where+  fail = WDT . fail+ -- | Lift a value from the inner transformed monad liftWebDriverTT   :: (Monad eff, Monad (t eff), MonadTrans t)@@ -281,7 +300,7 @@   :: (Monad eff, Monad (t eff), MonadTrans t)   => WebDriverConfig eff   -> WebDriverTT t eff a-  -> t eff (Either String a, AssertionSummary)+  -> t eff (Either Text a, AssertionSummary) debugWebDriverTT config session = do   (result, _, w) <- execWebDriverTT config session   let output = case result of@@ -326,7 +345,7 @@   :: (Monad eff)   => WebDriverConfig eff   -> WebDriverT eff a-  -> eff (Either String a, AssertionSummary)+  -> eff (Either Text a, AssertionSummary) debugWebDriverT config session = do   (result, _, w) <- execWebDriverT config session   let output = case result of@@ -377,7 +396,7 @@ -- | Write a comment to the log. comment   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -> WebDriverTT t eff ()+  => Text -> WebDriverTT t eff () comment = WDT . Http.comment  -- | Suspend the current session. Handy when waiting for pages to load.@@ -461,7 +480,7 @@ lookupKeyJson   :: (Monad eff, Monad (t eff), MonadTrans t)   => Text -> Value -> WebDriverTT t eff Value-lookupKeyJson key = WDT . Http.lookupKeyJson key+lookupKeyJson k = WDT . Http.lookupKeyJson k  -- | May throw a `JsonError`. constructFromJson@@ -508,13 +527,13 @@ -- | Capures `IOException`s. hPutStrLn   :: (Monad eff, Monad (t eff), MonadTrans t)-  => Handle -> String -> WebDriverTT t eff ()+  => Handle -> Text -> WebDriverTT t eff () hPutStrLn h = WDT . Http.hPutStrLn h  -- | Capures `IOException`s. hPutStrLnBlocking   :: (Monad eff, Monad (t eff), MonadTrans t)-  => MVar () -> Handle -> String -> WebDriverTT t eff ()+  => MVar () -> Handle -> Text -> WebDriverTT t eff () hPutStrLnBlocking lock h = WDT . Http.hPutStrLnBlocking lock h  promptWDAct@@ -549,27 +568,27 @@   = NoSession    -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#handling-errors>-  | ResponseError ResponseErrorCode String String (Maybe Value) Status+  | ResponseError ResponseErrorCode Text Text (Maybe Value) Status    | UnableToConnect   | RemoteEndTimeout   | UnhandledHttpException N.HttpException-  | ImageDecodeError String-  | UnexpectedValue String-  | UnexpectedResult Outcome String+  | ImageDecodeError Text+  | UnexpectedValue Text+  | UnexpectedResult Outcome Text   | BreakpointHaltError   deriving Show  -- | Read-only environment variables specific to WebDriver. data WDEnv = WDEnv   { -- | Hostname of the remote WebDriver server-    _remoteHostname :: String+    _remoteHostname :: Text      -- | Port of the remote WebDriver server   , _remotePort :: Int      -- | Extra path for the remote WebDriver server-  , _remotePath :: String+  , _remotePath :: Text      -- | Path where secret data is stored   , _dataPath :: FilePath@@ -600,9 +619,9 @@   | BreakpointsOff   deriving (Eq, Show) --- | Includes a @Maybe String@ representing the current session ID, if one has been opened.+-- | Includes a @Maybe Text@ representing the current session ID, if one has been opened. data WDState = WDState-  { _sessionId :: Maybe String+  { _sessionId :: Maybe Text   , _breakpoints :: BreakpointSetting   } deriving Show @@ -628,13 +647,13 @@ data WDLog   = LogAssertion Assertion   | LogSession SessionVerb-  | LogUnexpectedResult Outcome String-  | LogBreakpoint String+  | LogUnexpectedResult Outcome Text+  | LogBreakpoint Text   deriving Show  -- | Pretty printer for log entries.-printWDLog :: Bool -> WDLog -> String-printWDLog _ w = show w+printWDLog :: Bool -> WDLog -> Text+printWDLog _ w = T.pack $ show w  -- | Type representing an abstract outcome. Do with it what you will. data Outcome = IsSuccess | IsFailure@@ -651,8 +670,8 @@   WriteFilePath :: FilePath -> ByteString -> WDAct (Either IOException ())   FileExists :: FilePath -> WDAct (Either IOException Bool) -  HGetLine :: Handle -> WDAct (Either IOException String)-  HGetLineNoEcho :: Handle -> WDAct (Either IOException String)+  HGetLine :: Handle -> WDAct (Either IOException Text)+  HGetLineNoEcho :: Handle -> WDAct (Either IOException Text)   @@ -665,19 +684,19 @@ expect x y = if x == y   then return y   else throwError $ UnexpectedValue $-    "expected " ++ show x ++ " but got " ++ show y+    "expected " <> T.pack (show x) <> " but got " <> T.pack (show y)  -- | For validating responses. Throws an `UnexpectedValue` error if the `a` argument does not satisfy the predicate. expectIs   :: (Monad eff, Monad (t eff), MonadTrans t, Show a)   => (a -> Bool)-  -> String -- ^ Human readable error label+  -> Text -- ^ Human readable error label   -> a   -> WebDriverTT t eff a expectIs p label x = if p x   then return x   else throwError $ UnexpectedValue $-    "expected " ++ label ++ " but got " ++ show x+    "expected " <> label <> " but got " <> T.pack (show x)  -- | Promote semantic HTTP exceptions to typed errors. promoteHttpResponseError :: N.HttpException -> Maybe WDError@@ -687,8 +706,8 @@     code <- case fromJSON err of       Success m -> return m       _ -> Nothing-    msg <- fmap unpack (r ^? key "value" . key "message" . _String)-    str <- fmap unpack (r ^? key "value" . key "stacktrace" . _String)+    msg <- r ^? key "value" . key "message" . _String+    str <- r ^? key "value" . key "stacktrace" . _String     let obj = r ^? key "value" . key "data" . _Value     status <- s ^? responseStatus     return $ ResponseError code msg str obj status@@ -700,16 +719,16 @@   _ -> Just $ UnhandledHttpException e  -- | For pretty printing.-printWDError :: Bool -> WDError -> String-printWDError json e = case e of+printWDError :: Bool -> WDError -> Text+printWDError _ e = case e of   NoSession -> "No session in progress"-  ResponseError code msg trace obj status ->+  ResponseError _ msg trace obj status ->     let       code = status ^. statusCode       smsg = status ^. statusMessage     in-      (("Response: " ++ show code ++ " " ++ SC.unpack smsg ++ "\n") ++) $-      LC.unpack $ encodePretty $ object+      (("Response: " <> T.pack (show code) <> " " <> T.decodeUtf8 smsg <> "\n") <>) $+      T.decodeUtf8 $ toStrict $ encodePretty $ object         [ "error" .= toJSON code         , "message" .= toJSON msg         , "stacktrace" .= toJSON trace@@ -717,24 +736,24 @@         ]   UnableToConnect -> "Unable to connect to WebDriver server"   RemoteEndTimeout -> "Remote End Timeout"-  UnhandledHttpException e -> "Unhandled HTTP Exception: " ++ show e-  ImageDecodeError msg -> "Image decode: " ++ msg-  UnexpectedValue msg -> "Unexpected value: " ++ msg+  UnhandledHttpException ex -> "Unhandled HTTP Exception: " <> T.pack (show ex)+  ImageDecodeError msg -> "Image decode: " <> msg+  UnexpectedValue msg -> "Unexpected value: " <> msg   UnexpectedResult r msg -> case r of-    IsSuccess -> "Unexpected success: " ++ msg-    IsFailure -> "Unexpected failure: " ++ msg+    IsSuccess -> "Unexpected success: " <> msg+    IsFailure -> "Unexpected failure: " <> msg   BreakpointHaltError -> "Breakpoint Halt"  putStrLn   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -> WebDriverTT t eff ()+  => Text -> WebDriverTT t eff () putStrLn str = do   outH <- fromEnv (_stdout . Http._env)   hPutStrLn outH str  getStrLn   :: (Monad eff, Monad (t eff), MonadTrans t)-  => WebDriverTT t eff String+  => WebDriverTT t eff Text getStrLn = do   inH <- fromEnv (_stdin . Http._env)   result <- promptWDAct $ HGetLine inH@@ -745,16 +764,16 @@ -- | Prompt for input on `stdin`. promptForString   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -- ^ Prompt text-  -> WebDriverTT t eff String+  => Text -- ^ Prompt text+  -> WebDriverTT t eff Text promptForString prompt =   putStrLn prompt >> getStrLn  -- | Prompt for input on `stdin`, but do not echo the typed characters back to the terminal -- handy for getting suuper secret info. promptForSecret   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -- ^ Prompt text-  -> WebDriverTT t eff String+  => Text -- ^ Prompt text+  -> WebDriverTT t eff Text promptForSecret prompt = do   outH <- fromEnv (_stdout . Http._env)   inH <- fromEnv (_stdin . Http._env)@@ -808,7 +827,7 @@   | BreakpointAct -- ^ Client-supplied action   deriving (Eq, Show) -parseBreakpointAction :: String -> Maybe BreakpointAction+parseBreakpointAction :: Text -> Maybe BreakpointAction parseBreakpointAction str = case str of   "c" -> Just BreakpointContinue   "h" -> Just BreakpointHalt@@ -819,7 +838,7 @@  breakpointMessage   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String -> Maybe String -> WebDriverTT t eff ()+  => Text -> Maybe Text -> WebDriverTT t eff () breakpointMessage msg custom = do   putStrLn "=== BREAKPOINT ==="   putStrLn msg@@ -828,14 +847,14 @@   putStrLn "d : dump webdriver state"   putStrLn "s : turn breakpoints off and continue"   case custom of-    Just act -> putStrLn $ "a : " ++ act+    Just act -> putStrLn $ "a : " <> act     Nothing -> return ()   putStrLn "=================="  breakpointWith   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String-  -> Maybe (String, WebDriverTT t eff ())+  => Text+  -> Maybe (Text, WebDriverTT t eff ())   -> WebDriverTT t eff () breakpointWith msg act = do   bp <- fromState (_breakpoints . Http._userState)@@ -846,7 +865,7 @@       let         (actionDescription, action) = case act of           Nothing -> (Nothing, return ())-          Just (title, action) -> (Just title, action)+          Just (title, action') -> (Just title, action')       breakpointMessage msg actionDescription       command <- getStrLn       case parseBreakpointAction command of@@ -861,29 +880,29 @@         Just BreakpointSilence -> breakpointsOff         Just BreakpointAct -> action         Nothing -> do-          putStrLn $ "Unrecognized breakpoint option '" ++ command ++ "'"+          putStrLn $ "Unrecognized breakpoint option '" <> command <> "'"           breakpointWith msg act  breakpoint   :: (Monad eff, Monad (t eff), MonadTrans t)-  => String+  => Text   -> WebDriverTT t eff () breakpoint msg = breakpointWith msg Nothing -dumpState :: Http.S WDState -> String-dumpState Http.S{..} = intercalate "\n"-  [ "Session ID: " ++ show (_sessionId _userState)-  , show (_breakpoints _userState)+dumpState :: Http.S WDState -> Text+dumpState Http.S{..} = T.intercalate "\n"+  [ "Session ID: " <> T.pack (show $ _sessionId _userState)+  , T.pack $ show (_breakpoints _userState)   ] -dumpEnv :: Http.R WDError WDLog WDEnv -> String-dumpEnv Http.R{..} = intercalate "\n"-  [ "Remote Host: " ++ (_remoteHostname _env)-  , "Remote Port: " ++ show (_remotePort _env)-  , "Remote Path: " ++ (_remotePath _env)-  , "Data Path: " ++ (_dataPath _env)-  , "Response Format: " ++ show (_responseFormat _env)-  , "API Version: " ++ show (_apiVersion _env)+dumpEnv :: Http.R WDError WDLog WDEnv -> Text+dumpEnv Http.R{..} = T.intercalate "\n"+  [ "Remote Host: " <> (_remoteHostname _env)+  , "Remote Port: " <> T.pack (show $ _remotePort _env)+  , "Remote Path: " <> (_remotePath _env)+  , "Data Path: " <> T.pack (_dataPath _env)+  , "Response Format: " <> T.pack (show $ _responseFormat _env)+  , "API Version: " <> T.pack (show $ _apiVersion _env)   ]  @@ -896,12 +915,12 @@   FileExists path -> try $ doesFileExist path    HGetLine handle -> try $ do-    hGetLine handle+    T.hGetLine handle    HGetLineNoEcho handle -> try $ do     echo <- hGetEcho handle     hSetEcho handle False-    secret <- hGetLine handle+    secret <- T.hGetLine handle     hSetEcho handle echo     return secret @@ -917,12 +936,12 @@     case result of       Nothing -> do         return $ Left $ mkIOError doesNotExistErrorType "" Nothing (Just path)-      Just lns -> return $ Right $ LC.pack $ unlines lns+      Just lns -> return $ Right $ fromStrict $ T.encodeUtf8 $ T.unlines lns    WriteFilePath path bytes -> do     Mock.incrementTimer 1     fmap Right $ Mock.modifyMockWorld $ \w -> w-      { Mock._files = FS.writeLines (Left path) [LC.unpack bytes] $ Mock._files w }+      { Mock._files = FS.writeLines (Left path) [T.decodeUtf8 $ toStrict bytes] $ Mock._files w }    FileExists path -> do     Mock.incrementTimer 1@@ -937,9 +956,9 @@     let result = FS.readLine dne eof (Right handle) $ Mock._files world     case result of       Left err -> return $ Left err-      Right (str, fs) -> do+      Right (txt, fs) -> do         Mock.modifyMockWorld $ \w -> w { Mock._files = fs }-        return $ Right str+        return $ Right txt    HGetLineNoEcho handle -> do     Mock.incrementTimer 1@@ -949,6 +968,6 @@     let result = FS.readLine dne eof (Right handle) $ Mock._files world     case result of       Left err -> return $ Left err-      Right (str, fs) -> do+      Right (txt, fs) -> do         Mock.modifyMockWorld $ \w -> w { Mock._files = fs }-        return $ Right str+        return $ Right txt

@@ -12,15 +12,18 @@ Note that while the WebDriver spec defines some JSON objects, in general a given WebDriver server can accept additional properties on any given object. Our types here will be limited to the "spec" object signatures, but our API will need to be user extensible. -} -{-# LANGUAGE OverloadedStrings, RecordWildCards, BangPatterns #-}+{-# LANGUAGE OverloadedStrings, RecordWildCards, BangPatterns, CPP #-} module Web.Api.WebDriver.Types (   -- * Stringy Types     SessionId   , ElementRef(..)   , ContextId(..)+  , ContextType(..)   , Selector   , AttributeName   , PropertyName+  , AriaRole+  , AriaLabel   , Script   , CookieName   , CssPropertyName@@ -62,20 +65,40 @@   , ActionItem(..)   , emptyActionItem +  -- * Print+  , PrintOptions(..)+  , defaultPrintOptions+  , Orientation(..)+  , Scale(..)+  , Page(..)+  , defaultPage+  , Margin(..)+  , defaultMargin+  , PageRange(..)+  , Base64EncodedPdf(..)+  , decodeBase64EncodedPdf+  , writeBase64EncodedPdf+   -- * Misc   , LocationStrategy(..)   , Rect(..)   , emptyRect   , PromptHandler(..)   , Cookie(..)+  , cookie   , emptyCookie    -- * Error Responses   , ResponseErrorCode(..)   ) where -import Data.Char-  ( toLower )+#if MIN_VERSION_base(4,9,0)+import Prelude hiding (fail)+#endif++import Control.Monad.IO.Class+import qualified Data.ByteString as SB+import qualified Data.ByteString.Base64 as B64 import Data.Maybe   ( catMaybes ) import Data.Scientific@@ -83,29 +106,43 @@ import Data.String   ( IsString(..) ) import Data.HashMap.Strict-  ( HashMap, toList, fromList )+  ( HashMap, fromList ) import Data.Aeson.Types   ( ToJSON(..), FromJSON(..), Value(..), KeyValue   , Pair, (.:?), (.:), (.=), object, typeMismatch ) import Data.Text   ( Text, pack, unpack )+import qualified Data.Text as T+import Data.Text.Encoding+  ( encodeUtf8 ) import Test.QuickCheck-  ( Arbitrary(..), arbitraryBoundedEnum, Gen )+  ( Arbitrary(..), arbitraryBoundedEnum, Gen, NonNegative(..) ) import Test.QuickCheck.Gen-  ( listOf, oneof )+  ( listOf, oneof, elements )+import Text.Read+  ( readMaybe ) +-- Transitional MonadFail implementation+#if MIN_VERSION_base(4,9,0)+import Control.Monad.Fail+#endif++-- aeson 2.0.0.0 introduced KeyMap over HashMap+#if MIN_VERSION_aeson(2,0,0)+import Data.Aeson.Key (fromText)+#endif+ import Web.Api.WebDriver.Uri-import Web.Api.WebDriver.Types.Keyboard   -unrecognizedValue :: (Monad m) => String -> Text -> m a-unrecognizedValue !name !string = fail $-  "Unrecognized value for type " ++ name ++ ": " ++ unpack string+unrecognizedValue :: (MonadFail m) => Text -> Text -> m a+unrecognizedValue !name !string = fail $ unpack $+  "Unrecognized value for type " <> name <> ": " <> string -malformedValue :: (Monad m) => String -> String -> m a-malformedValue !name !value = fail $-  "Malformed value for type" ++ name ++ ": " ++ value+malformedValue :: (MonadFail m) => Text -> Text -> m a+malformedValue !name !value = fail $ unpack $+  "Malformed value for type " <> name <> ": " <> value   @@ -113,55 +150,104 @@ object_ = object . filter (\(_, v) -> v /= Null) . catMaybes  (.==) :: (ToJSON v, KeyValue kv) => Text -> v -> Maybe kv-(.==) key value = Just (key .= value)+(.==) key value =+#if MIN_VERSION_aeson(2,0,0)+  Just ((fromText key) .= value) --    val = lookup (fromText key) obj+#else+  Just (key .= value)+#endif  (.=?) :: (ToJSON v, KeyValue kv) => Text -> Maybe v -> Maybe kv-(.=?) key = fmap (key .=)+(.=?) key =+#if MIN_VERSION_aeson(2,0,0)+  fmap ((fromText key) .=)+#else+  fmap (key .=)+#endif    -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-session-id>.-type SessionId = String+type SessionId = Text  -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-web-element-reference>. newtype ElementRef = ElementRef-  { theElementRef :: String+  { theElementRef :: Text   } deriving Eq  instance Show ElementRef where-  show (ElementRef str) = str+  show (ElementRef str) = unpack str  instance IsString ElementRef where-  fromString = ElementRef+  fromString = ElementRef . pack  -- | Identifier for a /browsing context/; see <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-current-browsing-context>. newtype ContextId = ContextId-  { theContextId :: String+  { theContextId :: Text   } deriving Eq  instance Show ContextId where-  show (ContextId str) = str+  show (ContextId str) = unpack str  instance IsString ContextId where-  fromString = ContextId+  fromString = ContextId . pack +instance FromJSON ContextId where+  parseJSON (String x) = return $ ContextId x+  parseJSON invalid = typeMismatch "ContextType" invalid++instance ToJSON ContextId where+  toJSON (ContextId x) = String x++instance Arbitrary ContextId where+  arbitrary = (ContextId . pack) <$> arbitrary++-- | Type of a /top level browsing context/; see <https://html.spec.whatwg.org/#top-level-browsing-context>.+data ContextType = WindowContext | TabContext+  deriving (Eq, Enum, Bounded)++instance Show ContextType where+  show t = case t of+    WindowContext -> "window"+    TabContext -> "tab"++instance FromJSON ContextType where+  parseJSON (String x) = case x of+    "window" -> return WindowContext+    "tab" -> return TabContext+    _ -> unrecognizedValue "ContextType" x+  parseJSON invalid = typeMismatch "ContextType" invalid++instance ToJSON ContextType where+  toJSON WindowContext = String "window"+  toJSON TabContext = String "tab"++instance Arbitrary ContextType where+  arbitrary = arbitraryBoundedEnum+ -- | For use with a /Locator Strategy/. See <https://w3c.github.io/webdriver/webdriver-spec.html#locator-strategies>.-type Selector = String+type Selector = Text  -- | Used with `getElementAttribute`.-type AttributeName = String+type AttributeName = Text  -- | Used with `getElementProperty`.-type PropertyName = String+type PropertyName = Text +-- | Used with `getComputedRole`+type AriaRole = Text++-- | Used with `getComputedLabel`+type AriaLabel = Text+ -- | Javascript-type Script = String+type Script = Text  -- | Used with `getNamedCookie`.-type CookieName = String+type CookieName = Text  -- | Used with `getElementCssValue`.-type CssPropertyName = String+type CssPropertyName = Text  -- | Possible frame references; see <https://w3c.github.io/webdriver/webdriver-spec.html#switch-to-frame>. data FrameReference@@ -309,10 +395,10 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#capabilities>. data Capabilities = Capabilities   { _browserName :: Maybe BrowserName -- ^ @browserName@-  , _browserVersion :: Maybe String -- ^ @browserVersion@+  , _browserVersion :: Maybe Text -- ^ @browserVersion@   , _platformName :: Maybe PlatformName -- ^ @platformName@   , _acceptInsecureCerts :: Maybe Bool -- ^ @acceptInsecureCerts@-  , _pageLoadStrategy :: Maybe String -- ^ @pageLoadStrategy@+  , _pageLoadStrategy :: Maybe Text -- ^ @pageLoadStrategy@   , _proxy :: Maybe ProxyConfig -- ^ @proxy@   , _setWindowRect :: Maybe Bool -- ^ @setWindowRect@   , _timeouts :: Maybe TimeoutConfig -- ^ @timeouts@@@ -336,7 +422,7 @@     <*> v .:? "setWindowRect"     <*> v .:? "timeouts"     <*> v .:? "unhandledPromptBehavior"-    <*> v .:? "chromeOptions"+    <*> v .:? "goog:chromeOptions"     <*> v .:? "moz:firefoxOptions"   parseJSON invalid = typeMismatch "Capabilities" invalid @@ -351,17 +437,17 @@     , "setWindowRect" .=? (toJSON <$> _setWindowRect)     , "timeouts" .=? (toJSON <$> _timeouts)     , "unhandledPromptBehavior" .=? (toJSON <$> _unhandledPromptBehavior)-    , "chromeOptions" .=? (toJSON <$> _chromeOptions)+    , "goog:chromeOptions" .=? (toJSON <$> _chromeOptions)     , "moz:firefoxOptions" .=? (toJSON <$> _firefoxOptions)     ]  instance Arbitrary Capabilities where   arbitrary = Capabilities     <$> arbitrary-    <*> arbitrary-    <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary     <*> arbitrary@@ -454,7 +540,7 @@ -- | See <https://sites.google.com/a/chromium.org/chromedriver/capabilities>. data ChromeOptions = ChromeOptions   { _chromeBinary :: Maybe FilePath -- ^ @binary@-  , _chromeArgs :: Maybe [String] -- ^ @args@+  , _chromeArgs :: Maybe [Text] -- ^ @args@   , _chromePrefs :: Maybe (HashMap Text Value) -- ^ @prefs@   } deriving (Eq, Show) @@ -475,7 +561,7 @@ instance Arbitrary ChromeOptions where   arbitrary = ChromeOptions     <$> arbitrary-    <*> arbitrary+    <*> (fmap (fmap (fmap T.pack)) arbitrary)     <*> arbHashMap  -- | All members set to `Nothing`.@@ -491,7 +577,7 @@ -- | See <https://github.com/mozilla/geckodriver#firefox-capabilities>. data FirefoxOptions = FirefoxOptions   { _firefoxBinary :: Maybe FilePath -- ^ @binary@-  , _firefoxArgs :: Maybe [String] -- ^ @args@+  , _firefoxArgs :: Maybe [Text] -- ^ @args@   , _firefoxLog :: Maybe FirefoxLog   , _firefoxPrefs :: Maybe (HashMap Text Value) -- ^ @prefs@   } deriving (Eq, Show)@@ -515,7 +601,7 @@ instance Arbitrary FirefoxOptions where   arbitrary = FirefoxOptions     <$> arbitrary-    <*> arbitrary+    <*> (fmap (fmap (fmap T.pack)) arbitrary)     <*> arbitrary     <*> arbHashMap @@ -621,10 +707,10 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#proxy>. data ProxyConfig = ProxyConfig   { _proxyType :: Maybe ProxyType -- ^ @proxyType@-  , _proxyAutoconfigUrl :: Maybe String -- ^ @proxyAutoconfigUrl@+  , _proxyAutoconfigUrl :: Maybe Text -- ^ @proxyAutoconfigUrl@   , _ftpProxy :: Maybe HostAndOptionalPort -- ^ @ftpProxy@   , _httpProxy :: Maybe HostAndOptionalPort -- ^ @httpProxy@-  , _noProxy :: Maybe [String] -- ^ @noProxy@+  , _noProxy :: Maybe [Text] -- ^ @noProxy@   , _sslProxy :: Maybe HostAndOptionalPort -- ^ @sslProxy@   , _socksProxy :: Maybe HostAndOptionalPort -- ^ @socksProxy@   , _socksVersion :: Maybe Int -- ^ @socksVersion@@@ -657,10 +743,10 @@ instance Arbitrary ProxyConfig where   arbitrary = ProxyConfig     <$> arbitrary-    <*> arbitrary-    <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary+    <*> (fmap (fmap (fmap T.pack)) arbitrary)     <*> arbitrary     <*> arbitrary     <*> arbitrary@@ -687,26 +773,29 @@   } deriving (Eq, Show)  instance FromJSON HostAndOptionalPort where-  parseJSON (String x) =-    let string = unpack x in-    case span (/= ':') string of-      ("",_) -> malformedValue "Host" string-      (str,[]) -> case mkHost str of-        Nothing -> malformedValue "Host" string-        Just h -> return HostAndOptionalPort-          { _urlHost = h-          , _urlPort = Nothing-          }-      (str,":") -> malformedValue "Port" string-      (str,':':rest) -> case mkHost str of-        Nothing -> malformedValue "Host" string-        Just h -> case mkPort rest of-          Nothing -> malformedValue "Port" rest-          Just p -> return HostAndOptionalPort+  parseJSON (String string) =+    let (as,bs') = T.span (/= ':') string+    in if T.null as+      then malformedValue "Host" string+      else case T.uncons bs' of+        Nothing -> case mkHost as of+          Nothing -> malformedValue "Host" string+          Just h -> return HostAndOptionalPort             { _urlHost = h-            , _urlPort = Just p+            , _urlPort = Nothing             }-      (str,rest) -> malformedValue "Host" string+        Just (c,bs) -> if c /= ':'+          then malformedValue "Host" string+          else if T.null bs+            then malformedValue "Port" string+            else case mkHost as of+              Nothing -> malformedValue "Host" string+              Just h -> case mkPort bs of+                Nothing -> malformedValue "Port" bs+                Just p -> return HostAndOptionalPort+                  { _urlHost = h+                  , _urlPort = Just p+                  }   parseJSON invalid = typeMismatch "HostAndOptionalPort" invalid  instance ToJSON HostAndOptionalPort where@@ -879,7 +968,7 @@ -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#processing-actions-requests>. data Action = Action   { _inputSourceType :: Maybe InputSource -- ^ @type@-  , _inputSourceId :: Maybe String -- ^ @id@+  , _inputSourceId :: Maybe Text -- ^ @id@   , _inputSourceParameters :: Maybe InputSourceParameter -- ^ @parameters@   , _actionItems :: [ActionItem] -- ^ @actions@   } deriving (Eq, Show)@@ -903,11 +992,12 @@ instance Arbitrary Action where   arbitrary = Action     <$> arbitrary-    <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary  -- | All members set to `Nothing` except `_actionItems`, which is the empty list.+emptyAction :: Action emptyAction = Action   { _inputSourceType = Nothing   , _inputSourceId = Nothing@@ -980,8 +1070,8 @@ data ActionItem = ActionItem   { _actionType :: Maybe ActionType -- ^ @type@   , _actionDuration :: Maybe Int -- ^ @duration@-  , _actionOrigin :: Maybe String -- ^ @origin@-  , _actionValue :: Maybe String -- ^ @value@+  , _actionOrigin :: Maybe Text -- ^ @origin@+  , _actionValue :: Maybe Text -- ^ @value@   , _actionButton :: Maybe Int -- ^ @button@   , _actionX :: Maybe Int -- ^ @x@   , _actionY :: Maybe Int -- ^ @y@@@ -1013,8 +1103,8 @@   arbitrary = ActionItem     <$> arbitrary     <*> arbitrary-    <*> arbitrary-    <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary     <*> arbitrary@@ -1113,13 +1203,13 @@  -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#dfn-table-for-cookie-conversion>. data Cookie = Cookie-  { _cookieName :: Maybe String -- ^ @name@-  , _cookieValue :: Maybe String -- ^ @value@-  , _cookiePath :: Maybe String -- ^ @path@-  , _cookieDomain :: Maybe String -- ^ @domain@+  { _cookieName :: Maybe Text -- ^ @name@+  , _cookieValue :: Maybe Text -- ^ @value@+  , _cookiePath :: Maybe Text -- ^ @path@+  , _cookieDomain :: Maybe Text -- ^ @domain@   , _cookieSecure :: Maybe Bool -- ^ @secure@   , _cookieHttpOnly :: Maybe Bool -- ^ @httpOnly@-  , _cookieExpiryTime :: Maybe String -- ^ @expiryTime@+  , _cookieExpiryTime :: Maybe Text -- ^ @expiryTime@   } deriving (Eq, Show)  instance ToJSON Cookie where@@ -1146,13 +1236,13 @@  instance Arbitrary Cookie where   arbitrary = Cookie-    <$> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary+    <$> (fmap (fmap T.pack) arbitrary)+    <*> (fmap (fmap T.pack) arbitrary)+    <*> (fmap (fmap T.pack) arbitrary)+    <*> (fmap (fmap T.pack) arbitrary)     <*> arbitrary     <*> arbitrary+    <*> (fmap (fmap T.pack) arbitrary)  -- | All members set to `Nothing`. emptyCookie :: Cookie@@ -1168,10 +1258,248 @@  -- | All members other than @name@ and @value@ set to `Nothing`. cookie-  :: String -- ^ @name@-  -> String -- ^ @value@+  :: Text -- ^ @name@+  -> Text -- ^ @value@   -> Cookie cookie name value = emptyCookie   { _cookieName = Just name   , _cookieValue = Just value   }++++-- | See <https://w3c.github.io/webdriver/#print-page>+data PrintOptions = PrintOptions+  { _orientation :: Maybe Orientation -- ^ @orientation@+  , _scale :: Maybe Scale -- ^ @scale@+  , _background :: Maybe Bool -- ^ @background@+  , _page :: Maybe Page -- ^ @page@+  , _margin :: Maybe Margin -- ^ @margin@+  , _shrinkToFit :: Maybe Bool -- ^ @shrinkToFit@+  , _pageRanges :: Maybe [PageRange] -- ^ @pageRanges@+  } deriving (Eq, Show)++defaultPrintOptions :: PrintOptions+defaultPrintOptions = PrintOptions+  { _orientation = Nothing+  , _scale = Nothing+  , _background = Nothing+  , _page = Nothing+  , _margin = Nothing+  , _shrinkToFit = Nothing+  , _pageRanges = Nothing+  }++instance ToJSON PrintOptions where+  toJSON PrintOptions{..} = object_+    [ "orientation" .=? (toJSON <$> _orientation)+    , "scale" .=? (toJSON <$> _scale)+    , "background" .=? (toJSON <$> _background)+    , "page" .=? (toJSON <$> _page)+    , "margin" .=? (toJSON <$> _margin)+    , "shrinkToFit" .=? (toJSON <$> _shrinkToFit)+    , "pageRanges" .=? (toJSON <$> _pageRanges)+    ]++instance FromJSON PrintOptions where+  parseJSON (Object v) = PrintOptions+    <$> v .:? "orientation"+    <*> v .:? "scale"+    <*> v .:? "background"+    <*> v .:? "page"+    <*> v .:? "margin"+    <*> v .:? "shrinkToFit"+    <*> v .:? "pageRanges"+  parseJSON invalid = typeMismatch "PrintOptions" invalid++instance Arbitrary PrintOptions where+  arbitrary = PrintOptions+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++++data Orientation+  = Landscape+  | Portrait+  deriving (Eq, Show, Enum, Bounded)++instance FromJSON Orientation where+  parseJSON (String x) = case x of+    "landscape" -> return Landscape+    "portrait" -> return Portrait+    _ -> unrecognizedValue "Orientation" x+  parseJSON invalid = typeMismatch "Orientation" invalid++instance ToJSON Orientation where+  toJSON x = case x of+    Landscape -> String "landscape"+    Portrait -> String "portrait"++instance Arbitrary Orientation where+  arbitrary = arbitraryBoundedEnum++++newtype Scale+  = Scale Scientific+  deriving (Eq, Show)++instance ToJSON Scale where+  toJSON (Scale x) = toJSON x++instance FromJSON Scale where+  parseJSON = fmap Scale . parseJSON++instance Arbitrary Scale where -- TODO: fix this+  arbitrary = Scale+    <$> elements+      [ 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0+      , 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9, 2.0+      ]++++data Page = Page+  { _pageWidth :: Maybe Scientific -- ^ @pageWidth@+  , _pageHeight :: Maybe Scientific -- ^ @pageHeight@+  } deriving (Eq, Show)++defaultPage :: Page+defaultPage = Page+  { _pageWidth = Nothing+  , _pageHeight = Nothing+  }++instance ToJSON Page where+  toJSON Page{..} = object_+    [ "pageWidth" .=? (toJSON <$> _pageWidth)+    , "pageHeight" .=? (toJSON <$> _pageHeight)+    ]++instance FromJSON Page where+  parseJSON (Object v) = Page+    <$> v .:? "pageWidth"+    <*> v .:? "pageHeight"+  parseJSON invalid = typeMismatch "Page" invalid++instance Arbitrary Page where+  arbitrary =+    let+      margins = map negate+        [ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9+        , 1.0, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9+        ]+    in Page+      <$> oneof [ return Nothing, Just <$> elements (map (27.94 +) margins) ]+      <*> oneof [ return Nothing, Just <$> elements (map (21.59 +) margins) ]++++data Margin = Margin+  { _marginTop :: Maybe Scientific -- ^ @marginTop@+  , _marginBottom :: Maybe Scientific -- ^ @marginBottom@+  , _marginLeft :: Maybe Scientific -- ^ @marginLeft@+  , _marginRight :: Maybe Scientific -- ^ @marginRight@+  } deriving (Eq, Show)++defaultMargin :: Margin+defaultMargin = Margin+  { _marginTop = Nothing+  , _marginBottom = Nothing+  , _marginLeft = Nothing+  , _marginRight = Nothing+  }++instance ToJSON Margin where+  toJSON Margin{..} = object_+    [ "marginTop" .=? (toJSON <$> _marginTop)+    , "marginBottom" .=? (toJSON <$> _marginBottom)+    , "marginLeft" .=? (toJSON <$> _marginLeft)+    , "marginRight" .=? (toJSON <$> _marginRight)+    ]++instance FromJSON Margin where+  parseJSON (Object v) = Margin+    <$> v .:? "marginTop"+    <*> v .:? "marginBottom"+    <*> v .:? "marginLeft"+    <*> v .:? "marginRight"+  parseJSON invalid = typeMismatch "Margin" invalid++instance Arbitrary Margin where+  arbitrary =+    let+      margins =+        [ 0.0, 0.1, 0.2, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9+        , 1.0, 1.1, 1.2, 1.3, 1.4, 1.5, 1.6, 1.7, 1.8, 1.9+        ]+    in Margin+      <$> oneof [ return Nothing, Just <$> elements margins ]+      <*> oneof [ return Nothing, Just <$> elements margins ]+      <*> oneof [ return Nothing, Just <$> elements margins ]+      <*> oneof [ return Nothing, Just <$> elements margins ]++++data PageRange+  = OnePage Int+  | PageRange Int Int+  deriving (Eq, Show)++instance ToJSON PageRange where+  toJSON x = case x of+    OnePage k -> String $ pack $ show k+    PageRange a b -> String $ mconcat+      [ pack $ show a, "-", pack $ show b ]++instance FromJSON PageRange where+  parseJSON (String str) =+    let (as, bs') = T.break (== '-') str+    in case T.uncons bs' of+      Nothing -> case readMaybe $ unpack as of+        Just k -> return $ OnePage k+        Nothing -> malformedValue "page range" str+      Just (_,bs) -> if (T.null as) || (T.null bs)+        then malformedValue "page range" str+        else case (readMaybe $ unpack as, readMaybe $ unpack bs) of+          (Just a, Just b) -> return $ PageRange a b+          _ -> malformedValue "page range" str+  parseJSON invalid = typeMismatch "PageRange" invalid++instance Arbitrary PageRange where+  arbitrary = do+    NonNegative a <- fmap (fmap (`mod` 100)) arbitrary+    oneof+      [ return $ OnePage a+      , do+          NonNegative b <- fmap (fmap (`mod` 100)) arbitrary+          return $ PageRange (min a b) (max a b)+      ]++++newtype Base64EncodedPdf+  = Base64EncodedPdf SB.ByteString+  deriving (Eq, Show)++instance FromJSON Base64EncodedPdf where+  parseJSON (String s) =+    return $ Base64EncodedPdf $ encodeUtf8 s+  parseJSON invalid = typeMismatch "Base64EncodedPdf" invalid++decodeBase64EncodedPdf+  :: Base64EncodedPdf -> SB.ByteString+decodeBase64EncodedPdf (Base64EncodedPdf bytes)+  = B64.decodeLenient bytes++writeBase64EncodedPdf+  :: ( MonadIO m )+  => FilePath -> Base64EncodedPdf -> m ()+writeBase64EncodedPdf path pdf =+  liftIO $ SB.writeFile path $ decodeBase64EncodedPdf pdf

@@ -15,57 +15,59 @@   , mkPort   ) where +import Data.Text (Text)+import qualified Data.Text as T import Test.QuickCheck   ( Arbitrary(..), oneof, vectorOf, Positive(..) )   -- | The host part of a URI. See <https://tools.ietf.org/html/rfc3986#page-18>. newtype Host = Host-  { unHost :: String+  { unHost :: Text   } deriving Eq  -- | Constructor for hosts that checks for invalid characters.-mkHost :: String -> Maybe Host+mkHost :: Text -> Maybe Host mkHost str =-  if all (`elem` hostAllowedChars) str+  if T.all (`elem` hostAllowedChars) str     then Just (Host str)     else Nothing  instance Show Host where-  show = unHost+  show = T.unpack . unHost  instance Arbitrary Host where   arbitrary = do     Positive k <- arbitrary     str <- vectorOf k $ oneof $ map return hostAllowedChars-    case mkHost str of+    case mkHost $ T.pack str of       Just h -> return h       Nothing -> error "In Arbitrary instance for Host: bad characters." -hostAllowedChars :: String+hostAllowedChars :: [Char] hostAllowedChars = concat   [ ['a'..'z'], ['A'..'Z'], ['0'..'9'], ['-','_','.','~','%'] ]    -- | The port part of a URI.-newtype Port = Port { unPort :: String }+newtype Port = Port { unPort :: Text }   deriving Eq  -- | Constructor for ports.-mkPort :: String -> Maybe Port+mkPort :: Text -> Maybe Port mkPort str =-  if all (`elem` ['0'..'9']) str+  if T.all (`elem` ['0'..'9']) str     then Just (Port str)     else Nothing  instance Show Port where-  show = unPort+  show = T.unpack . unPort  instance Arbitrary Port where   arbitrary = do     Positive k <- arbitrary     str <- vectorOf k $ oneof $ map return ['0'..'9']-    case mkPort str of+    case mkPort $ T.pack str of       Just p -> return p       Nothing -> error "In Arbitrary instance for Port: bad characters."

@@ -1,10 +1,8 @@ module Main where  import System.Environment (setEnv, getArgs, withArgs)-import System.Exit (exitFailure) import System.Directory (getCurrentDirectory) import Control.Concurrent.MVar (newMVar)-import Data.IORef  import Test.Tasty import Test.Tasty.WebDriver

@@ -1,7 +1,11 @@+{-# LANGUAGE OverloadedStrings #-} module Test.Tasty.WebDriver.Config.Test (     tests   ) where +import Data.Text (Text)+import qualified Data.Text as Text+ import qualified Test.Tasty as TT import qualified Test.Tasty.HUnit as HU import qualified Data.Map.Strict as MS@@ -15,21 +19,21 @@   , check_parseRemoteEndConfig   ] -checkParser :: (Eq a, Show a) => (String -> a) -> (String, String, a) -> TT.TestTree+checkParser :: (Eq a, Show a) => (Text -> a) -> (String, Text, a) -> TT.TestTree checkParser f (title, str, x) =   let y = f str in   HU.testCase title $     if y == x       then return ()       else do-        HU.assertFailure $ "Error parsing '" ++ str ++ "': expected "+        HU.assertFailure $ "Error parsing '" ++ Text.unpack str ++ "': expected "           ++ show x ++ " but got " ++ show y  check_parseRemoteEnd :: TT.TestTree check_parseRemoteEnd = TT.testGroup "parseRemoteEnd" $   map (checkParser parseRemoteEnd) _parseRemoteEnd_cases -_parseRemoteEnd_cases :: [(String, String, Either String RemoteEnd)]+_parseRemoteEnd_cases :: [(String, Text, Either Text RemoteEnd)] _parseRemoteEnd_cases =   [ ( "'localhost'"     , "localhost"@@ -66,7 +70,7 @@ check_parseRemoteEndOption = TT.testGroup "parseRemoteEndOption" $   map (checkParser parseRemoteEndOption) _parseRemoteEndOption_cases -_parseRemoteEndOption_cases :: [(String, String, Either String RemoteEndPool)]+_parseRemoteEndOption_cases :: [(String, Text, Either Text RemoteEndPool)] _parseRemoteEndOption_cases =   [ ( "geckodriver+1"     , "geckodriver https://localhost:4444"@@ -118,7 +122,7 @@ check_parseRemoteEndConfig = TT.testGroup "parseRemoteEndConfig" $   map (checkParser parseRemoteEndConfig) _parseRemoteEndConfig_cases -_parseRemoteEndConfig_cases :: [(String, String, Either String RemoteEndPool)]+_parseRemoteEndConfig_cases :: [(String, Text, Either Text RemoteEndPool)] _parseRemoteEndConfig_cases =   [ ( "geckodriver+1"     , "geckodriver\n- https://localhost:4444\n"

@@ -9,7 +9,11 @@ import qualified Test.Tasty as TT (TestTree(), testGroup) import qualified Test.Tasty.QuickCheck as QC (testProperty) import qualified Test.Tasty.HUnit as HU+import Test.QuickCheck (Arbitrary(..)) +import Data.Text (Text)+import qualified Data.Text as T+ import Control.Concurrent (MVar) import qualified Network.Wreq as Wreq import qualified Data.Map as MS@@ -33,8 +37,11 @@     ]   ] +instance Arbitrary Text where+  arbitrary = T.pack <$> arbitrary  + condIO   :: IO (Either (E WDError) t, S WDState, W WDError WDLog)   -> IO AssertionSummary@@ -125,179 +132,237 @@     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show k ++ " is equal to " ++ show k)-          (fromString $ show k)+          (AssertionStatement $+            T.pack (show k) <> " is equal to " <> T.pack (show k))+          (AssertionComment $ T.pack $ show k)         ]       ) $       do-        assertEqual (k :: Int) k (fromString $ show k)+        assertEqual+          (k :: Int) k+          (AssertionComment $ T.pack $ show k)    , QC.testProperty "assertEqual (Int, failure)" $ \k ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show (k+1) ++ " is equal to " ++ show k)-          (fromString $ show k)+          (AssertionStatement $+            T.pack (show (k+1)) <> " is equal to " <> T.pack (show k))+          (AssertionComment $ T.pack $ show k)         ]       ) $       do-        assertEqual (k+1 :: Int) k (fromString $ show k)+        assertEqual+          (k+1 :: Int) k+          (AssertionComment $ T.pack $ show k) -  , QC.testProperty "assertEqual (String, success)" $ \str ->+  , QC.testProperty "assertEqual (Text, success)" $ \str ->     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show str ++ " is equal to " ++ show str)-          (fromString str)+          (AssertionStatement $+            T.pack (show str) <> " is equal to " <> T.pack (show str))+          (AssertionComment str)         ]       ) $       do-        assertEqual (str :: String) str (fromString str)+        assertEqual+          (str :: Text) str+          (AssertionComment str) -  , QC.testProperty "assertEqual (String, failure)" $ \str ->+  , QC.testProperty "assertEqual (Text, failure)" $ \str ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show (str++"?") ++ " is equal to " ++ show str)-          (fromString str)+          (AssertionStatement $+            T.pack (show $ str <> "?") <> " is equal to " <> T.pack (show str))+          (AssertionComment str)         ]       ) $       do-        assertEqual (str++"?" :: String) str (fromString str)+        assertEqual+          (str <> "?" :: Text) str+          (AssertionComment str)    , QC.testProperty "assertNotEqual (Int, success)" $ \k ->     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show (k+1) ++ " is not equal to " ++ show k)-          (fromString $ show k)+          (AssertionStatement $+            T.pack (show (k+1)) <> " is not equal to " <> T.pack (show k))+          (AssertionComment $ T.pack $ show k)         ]       ) $       do-        assertNotEqual (k+1 :: Int) k (fromString $ show k)+        assertNotEqual+          (k+1 :: Int) k+          (AssertionComment $ T.pack $ show k)    , QC.testProperty "assertNotEqual (Int, failure)" $ \k ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show k ++ " is not equal to " ++ show k)-          (fromString $ show k)+          (AssertionStatement $+            T.pack (show k) <> " is not equal to " <> T.pack (show k))+          (AssertionComment $ T.pack $ show k)         ]       ) $       do-        assertNotEqual (k :: Int) k (fromString $ show k)+        assertNotEqual+          (k :: Int) k+          (AssertionComment $ T.pack $ show k) -  , QC.testProperty "assertNotEqual (String, success)" $ \str ->+  , QC.testProperty "assertNotEqual (Text, success)" $ \str ->     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show (str++"?") ++ " is not equal to " ++ show str)-          (fromString str)+          (AssertionStatement $+            T.pack (show (str <> "?")) <> " is not equal to " <> T.pack (show str))+          (AssertionComment str)         ]       ) $       do-        assertNotEqual (str++"?" :: String) str (fromString str)+        assertNotEqual+          (str <> "?" :: Text)+          (str)+          (AssertionComment str) -  , QC.testProperty "assertNotEqual (String, failure)" $ \str ->+  , QC.testProperty "assertNotEqual (Text, failure)" $ \str ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show str ++ " is not equal to " ++ show str)-          (fromString str)+          (AssertionStatement $+            T.pack (show str) <> " is not equal to " <> T.pack (show str))+          (AssertionComment str)         ]       ) $       do-        assertNotEqual (str :: String) str (fromString str)+        assertNotEqual+          (str :: Text)+          (str)+          (AssertionComment str)      , QC.testProperty "assertIsSubstring (success)" $ \str1 str2 ->     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show str1 ++ " is a substring of " ++ show (str2++str1++str2))-          (fromString str1)+          (AssertionStatement $+            T.pack (show str1) <> " is a substring of " <> T.pack (show $ str2 <> str1 <> str2))+          (AssertionComment str1)         ]       ) $       do-        assertIsSubstring (str1 :: String) (str2++str1++str2) (fromString str1)+        assertIsSubstring+          (str1 :: Text)+          (str2 <> str1 <> str2)+          (AssertionComment str1)      , QC.testProperty "assertIsSubstring (failure)" $ \c str1 str2 ->-    let str3 = filter (/= c) str2 in+    let str3 = T.filter (/= c) str2 in     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show (c:str1) ++ " is a substring of " ++ show str3)-          (fromString str1)+          (AssertionStatement $+            T.pack (show $ T.cons c str1) <> " is a substring of " <> T.pack (show str3))+          (AssertionComment str1)         ]       ) $       do-        assertIsSubstring (c:str1 :: String) (str3) (fromString str1)+        assertIsSubstring+          (T.cons c str1 :: Text)+          (str3)+          (AssertionComment str1)      , QC.testProperty "assertIsNotSubstring (success)" $ \c str1 str2 ->-    let str3 = filter (/= c) str2 in+    let str3 = T.filter (/= c) str2 in     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show (c:str1) ++ " is not a substring of " ++ show str3)-          (fromString str1)+          (AssertionStatement $+            T.pack (show $ T.cons c str1) <> " is not a substring of " <> T.pack (show str3))+          (AssertionComment str1)         ]       ) $       do-        assertIsNotSubstring (c:str1 :: String) (str3) (fromString str1)+        assertIsNotSubstring+          (T.cons c str1 :: Text)+          (str3)+          (AssertionComment str1)      , QC.testProperty "assertIsNotSubstring (failure)" $ \str1 str2 ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show str1 ++ " is not a substring of " ++ show (str2++str1++str2))-          (fromString str1)+          (AssertionStatement $+            T.pack (show str1) <> " is not a substring of " <> T.pack (show $ str2 <> str1 <> str2))+          (AssertionComment str1)         ]       ) $       do-        assertIsNotSubstring (str1 :: String) (str2++str1++str2) (fromString str1)+        assertIsNotSubstring+          (str1 :: Text)+          (str2 <> str1 <> str2)+          (AssertionComment str1)      , QC.testProperty "assertIsNamedSubstring (success)" $ \name str1 str2 ->     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show str1 ++ " is a substring of " ++ name)-          (fromString str1)+          (AssertionStatement $+            T.pack (show str1) <> " is a substring of " <> name)+          (AssertionComment str1)         ]       ) $       do-        assertIsNamedSubstring (str1 :: String) (str2++str1++str2, name) (fromString str1)+        assertIsNamedSubstring+          (str1 :: Text)+          (str2 <> str1 <> str2, name)+          (AssertionComment str1)      , QC.testProperty "assertIsNamedSubstring (failure)" $ \name c str1 str2 ->-    let str3 = filter (/= c) str2 in+    let str3 = T.filter (/= c) str2 in     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show (c:str1) ++ " is a substring of " ++ name)-          (fromString str1)+          (AssertionStatement $+            T.pack (show $ T.cons c str1) <> " is a substring of " <> name)+          (AssertionComment str1)         ]       ) $       do-        assertIsNamedSubstring (c:str1 :: String) (str3,name) (fromString str1)+        assertIsNamedSubstring+          (T.cons c str1 :: Text)+          (str3, name)+          (AssertionComment str1)      , QC.testProperty "assertIsNotNamedSubstring (success)" $ \name c str1 str2 ->-    let str3 = filter (/= c) str2 in+    let str3 = T.filter (/= c) str2 in     checkWebDriverT config cond       (== summarize         [success-          (fromString $ show (c:str1) ++ " is not a substring of " ++ name)-          (fromString str1)+          (AssertionStatement $+            T.pack (show $ T.cons c str1) <> " is not a substring of " <> name)+          (AssertionComment str1)         ]       ) $       do-        assertIsNotNamedSubstring (c:str1 :: String) (str3,name) (fromString str1)+        assertIsNotNamedSubstring+          (T.cons c str1 :: Text)+          (str3, name)+          (AssertionComment str1)      , QC.testProperty "assertIsNotNamedSubstring (failure)" $ \name str1 str2 ->     checkWebDriverT config cond       (== summarize         [failure-          (fromString $ show str1 ++ " is not a substring of " ++ name)-          (fromString str1)+          (AssertionStatement $+            T.pack (show str1) <> " is not a substring of " <> name)+          (AssertionComment str1)         ]       ) $       do-        assertIsNotNamedSubstring (str1 :: String) (str2++str1++str2, name) (fromString str1)+        assertIsNotNamedSubstring+          (str1 :: Text)+          (str2 <> str1 <> str2, name)+          (AssertionComment str1)   ]

@@ -3,11 +3,7 @@     tests ) where -import Data.Typeable-  ( Typeable )-import System.IO--import Test.Tasty (TestTree(), testGroup, localOption, Timeout(NoTimeout))+import Test.Tasty (TestTree(), testGroup, localOption)  import Data.MockIO @@ -33,7 +29,7 @@     $ testGroup "Geckodriver" $ endpointTests testCase path    ,   localOption (Driver Chromedriver)-    $ localOption (ApiResponseFormat ChromeFormat)+    $ localOption (ApiResponseFormat SpecFormat)     $ localOption (Headless True)     $ ifTierIs TEST (localOption (BrowserPath $ Just "/usr/bin/google-chrome"))     $ localOption (SilentLog)

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, BangPatterns, FlexibleInstances, RecordWildCards #-}+{-# LANGUAGE OverloadedStrings, BangPatterns, FlexibleInstances, RecordWildCards, CPP #-} module Web.Api.WebDriver.Monad.Test.Server (     WebDriverServerState(..)   , defaultWebDriverServerState@@ -7,6 +7,7 @@  import Data.List import Data.Text (Text, pack, unpack)+import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import qualified Data.HashMap.Strict as HMS import qualified Data.ByteString.Lazy as LB@@ -38,7 +39,7 @@   { _files = emptyFileSystem   , _time = epoch   , _serverState = MockServer defaultWebDriverServerState-  , _httpGet = \url -> case splitUrl $ stripScheme url of+  , _httpGet = \url -> case splitUrl $ stripScheme $ T.unpack url of       {- Status -}       [_,"status"] ->         get_session_id_status@@ -103,6 +104,14 @@       [_,"session",session_id,"element",element_id,"enabled"] ->         get_session_id_element_id_enabled session_id element_id +      {- Get Computed Role -}+      [_,"session",session_id,"element",element_id,"computedrole"] ->+        get_session_id_element_id_computedrole session_id element_id++      {- Get Computed Label -}+      [_,"session",session_id,"element",element_id,"computedlabel"] ->+        get_session_id_element_id_computedlabel session_id element_id+       {- Get Page Source -}       [_,"session",session_id,"source"] ->         get_session_id_source session_id@@ -127,10 +136,10 @@       [_,"session",session_id,"element",element_id,"screenshot"] ->         get_session_id_element_id_screenshot session_id element_id -      _ -> error $ "defaultWebDriverServer: get url: " ++ url ++-        "' parsed as " ++ (show $ splitUrl $ stripScheme url)+      _ -> error $ "defaultWebDriverServer: get url: " ++ T.unpack url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme $ T.unpack url) -  , _httpPost = \url payload -> case splitUrl $ stripScheme url of+  , _httpPost = \url payload -> case splitUrl $ stripScheme $ T.unpack url of       {- New Session -}       [_,"session"] ->         post_session@@ -159,6 +168,10 @@       [_,"session",session_id,"window"] ->         post_session_id_window session_id payload +      {- New Window -}+      [_,"session",session_id,"window","new"] ->+        post_session_id_window_new session_id payload+       {- Switch To Frame -}       [_,"session",session_id,"frame"] ->         post_session_id_frame session_id payload@@ -239,10 +252,14 @@       [_,"session",session_id,"alert","text"] ->         post_session_id_alert_text session_id -      _ -> error $ "defaultWebDriverServer: post url: '" ++ url ++-        "' parsed as " ++ (show $ splitUrl $ stripScheme url)+      {- Print Page -}+      [_,"session",session_id,"print"] ->+        post_session_id_print session_id -  , _httpDelete = \url -> case splitUrl $ stripScheme url of+      _ -> error $ "defaultWebDriverServer: post url: '" ++ T.unpack url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme $ T.unpack url)++  , _httpDelete = \url -> case splitUrl $ stripScheme $ T.unpack url of       {- Delete Session -}       [_,"session",session_id] ->         delete_session_id session_id@@ -263,8 +280,8 @@       [_,"session",session_id,"actions"] ->         delete_session_id_actions session_id -      _ -> error $ "defaultWebDriverServer: delete url: " ++ url ++-        "' parsed as " ++ (show $ splitUrl $ stripScheme url)+      _ -> error $ "defaultWebDriverServer: delete url: " ++ T.unpack url +++        "' parsed as " ++ (show $ splitUrl $ stripScheme $ T.unpack url)   }  stripScheme :: String -> String@@ -453,6 +470,25 @@   return _success_with_empty_object  +{- New Window -}++post_session_id_window_new+  :: String+  -> LB.ByteString+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_window_new session_id payload = do+  verifyIsActiveSession session_id+  st <- getMockServer+  case _load_page "about:blank" st of -- not actually switching contexts here+    Nothing -> errorMockNetwork _err_unknown_error+    Just _st -> do+      modifyMockServer (const _st)+      return $ _success_with_value $ object+        [ ( "handle", String "handle-id" )+        , ( "type", String "tab" )+        ]++ {- Get Window Handles -}  get_session_id_window_handles@@ -719,6 +755,29 @@   verifyIsActiveSession session_id   return $ _success_with_value $ Bool True ++{- Get Computed Role -}++get_session_id_element_id_computedrole+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_computedrole session_id element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "textbox"+++{- Get Computed Label -}++get_session_id_element_id_computedlabel+  :: String+  -> String+  -> MockNetwork WebDriverServerState HttpResponse+get_session_id_element_id_computedlabel session_id element_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "textbox"++ post_session_id_element_id_click   :: String   -> String@@ -864,6 +923,16 @@   return $ _success_with_value $ String "WOO!!"  +{- Print Page -}++post_session_id_print+  :: String+  -> MockNetwork WebDriverServerState HttpResponse+post_session_id_print session_id = do+  verifyIsActiveSession session_id+  return $ _success_with_value $ String "WOO!!"++ {- Send Alert Text -}  post_session_id_alert_text@@ -958,6 +1027,10 @@   , responseBody = ()   , responseCookieJar = CJ []   , responseClose' = ResponseClose $ return ()+#if MIN_VERSION_http_client(0,7,8)+  , responseOriginalRequest =+      error "emptyResponse: responseOriginalRequest not defined"+#endif   }  _err_invalid_argument :: String -> HttpException

@@ -12,6 +12,7 @@   , cssMatchDocument   , parseCss   , tagIsClearable+  , pageAboutBlank   ) where  import Text.ParserCombinators.Parsec@@ -78,6 +79,12 @@ node tag attrs children =   let elementId = "" in   Document{..}++pageAboutBlank :: Page+pageAboutBlank = Page+  { contents = Text ""+  , url = "about:blank"+  }   assignIds :: String -> Document -> Document

@@ -96,11 +96,12 @@   -> Maybe WebDriverServerState _load_page path st = do   let file = fileOnly path-  p <- if file == "success.html"-    then return _success_page-    else if file == "invalidElementState.html"-      then return _invalidElementState_page-      else requestPage path (_internets st)+  p <- case file of+    "success.html"             -> return _success_page+    "example.com"              -> return _success_page+    "invalidElementState.html" -> return _invalidElementState_page+    "about:blank"              -> return pageAboutBlank+    _                          -> requestPage path (_internets st)   return $ st     { _current_page = p     , _history = (_current_page st) : _history st

@@ -10,6 +10,8 @@ import Web.Api.WebDriver import Test.Tasty.WebDriver +import qualified Data.Text as Text+ import qualified Test.Tasty as T import qualified Test.Tasty.ExpectedFailure as TE @@ -20,8 +22,8 @@   -> WebDriverT eff() invalidElementState e = case e of   ResponseError InvalidElementState _ _ _ _ -> assertSuccess "yay!"-  err -> assertFailure $-    AssertionComment $ "Expecting 'invalid element state' but got: " ++ show err+  err -> assertFailure $ AssertionComment $+    "Expecting 'invalid element state' but got: " <> Text.pack (show err)   invalidElementStateExit@@ -32,8 +34,7 @@ invalidElementStateExit buildTestCase dir =   let path = dir ++ "/invalidElementState.html" in   T.testGroup "Invalid Element State"-    [ ifDriverIs Chromedriver TE.ignoreTest $-        buildTestCase "elementClear" (_test_elementClear_invalid_element_state path)+    [ buildTestCase "elementClear" (_test_elementClear_invalid_element_state path)     ]  @@ -44,7 +45,7 @@   let     session :: (Monad eff) => WebDriverT eff()     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "body"       elementClear element       throwError $ UnexpectedResult IsSuccess "Expecting 'invalid_element_state'"

@@ -3,20 +3,21 @@     successfulExit   ) where -import System.IO- import Web.Api.WebDriver import Test.Tasty.WebDriver  import qualified Test.Tasty as T import qualified Test.Tasty.ExpectedFailure as TE +import qualified Data.Text as Text + unexpectedError   :: (Monad eff)   => WDError   -> WebDriverT eff ()-unexpectedError e = assertFailure $ AssertionComment $ "Unexpected error:\n" ++ show e+unexpectedError e = assertFailure $ AssertionComment $+  "Unexpected error:\n" <> Text.pack (show e)   successfulExit@@ -40,6 +41,7 @@     , buildTestCase "getWindowHandle" (_test_getWindowHandle_success)     , buildTestCase "switchToWindow" (_test_switchToWindow_success)     , buildTestCase "getWindowHandles" (_test_getWindowHandles_success path)+    , buildTestCase "newWindow" (_test_newWindow_success path)     , buildTestCase "switchToFrame" (_test_switchToFrame_success path)     , buildTestCase "switchToParentFrame" (_test_switchToParentFrame_success path)     , buildTestCase "getWindowRect" (_test_getWindowRect_success)@@ -57,44 +59,38 @@     , buildTestCase "getActiveElement" (_test_getActiveElement_success)     , buildTestCase "isElementSelected" (_test_isElementSelected_success path)     , buildTestCase "getElementAttribute" (_test_getElementAttribute_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "getElementCssValue" (_test_getElementCssValue_success path)+    , buildTestCase "getElementCssValue" (_test_getElementCssValue_success path)     , buildTestCase "getElementText" (_test_getElementText_success path)     , buildTestCase "getElementTagName" (_test_getElementTagName_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "getElementRect" (_test_getElementRect_success path)+    , buildTestCase "getElementRect" (_test_getElementRect_success path)     , buildTestCase "isElementEnabled" (_test_isElementEnabled_success path)+    ,   ifDriverIs Geckodriver TE.ignoreTest -- see https://bugzilla.mozilla.org/show_bug.cgi?id=1585622+      $ buildTestCase "getComputedRole" (_test_getComputedRole_success path)+    ,   ifDriverIs Geckodriver TE.ignoreTest -- see https://bugzilla.mozilla.org/show_bug.cgi?id=1585622+      $ buildTestCase "getComputedLabel" (_test_getComputedLabel_success path)     , buildTestCase "elementClick" (_test_elementClick_success path)     , buildTestCase "elementClear" (_test_elementClear_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "elementSendKeys" (_test_elementSendKeys_success path)+    , buildTestCase "elementSendKeys" (_test_elementSendKeys_success path)     , buildTestCase "getPageSource" (_test_getPageSource_success path)     , buildTestCase "getPageSourceStealth" (_test_getPageSourceStealth_success path)     , buildTestCase "getAllCookies" (_test_getAllCookies_success path)     ,   ifDriverIs Chromedriver TE.ignoreTest       $ T.localOption (PrivateMode False)       $ buildTestCase "getNamedCookie" (_test_getNamedCookie_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "deleteCookie" (_test_deleteCookie_success path)+    , buildTestCase "deleteCookie" (_test_deleteCookie_success path)     , buildTestCase "deleteAllCookies" (_test_deleteAllCookies_success)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "performActions (keyboard)" (_test_performActions_keyboard_success)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "performActionsStealth (keyboard)" (_test_performActionsStealth_keyboard_success)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "releaseActions" (_test_releaseActions_success)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "dismissAlert" (_test_dismissAlert_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "acceptAlert" (_test_acceptAlert_success path)+    , buildTestCase "performActions (keyboard)" (_test_performActions_keyboard_success)+    , buildTestCase "performActionsStealth (keyboard)" (_test_performActionsStealth_keyboard_success)+    , buildTestCase "releaseActions" (_test_releaseActions_success)+    , buildTestCase "dismissAlert" (_test_dismissAlert_success path)+    , buildTestCase "acceptAlert" (_test_acceptAlert_success path)     ,   ifDriverIs Chromedriver TE.ignoreTest       $ ifHeadless TE.ignoreTest       $ buildTestCase "getAlertText" (_test_getAlertText_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "sendAlertText" (_test_sendAlertText_success path)+    , buildTestCase "sendAlertText" (_test_sendAlertText_success path)     , buildTestCase "takeScreenshot" (_test_takeScreenshot_success path)-    ,   ifDriverIs Chromedriver TE.ignoreTest-      $ buildTestCase "takeElementScreenshot" (_test_takeElementScreenshot_success path)+    , buildTestCase "takeElementScreenshot" (_test_takeElementScreenshot_success path)+    , buildTestCase "printPage" (_test_printPage_success path)     ]  @@ -104,8 +100,8 @@ _test_sessionStatus_success page =   let     session = do-      navigateTo page-      (!r,!m) <- sessionStatus+      navigateTo $ Text.pack page+      _ <- sessionStatus       assertSuccess "yay"       return () @@ -118,7 +114,7 @@ _test_getTimeouts_success =   let     session = do-      !timeouts <- getTimeouts+      _ <- getTimeouts       assertSuccess "yay"       return () @@ -131,7 +127,7 @@ _test_setTimeouts_success =   let     session = do-      () <- setTimeouts emptyTimeoutConfig+      _ <- setTimeouts emptyTimeoutConfig       assertSuccess "yay"       return () @@ -144,7 +140,7 @@ _test_navigateTo_success page =   let     session = do-      () <- navigateTo page+      _ <- navigateTo $ Text.pack page       assertSuccess "yay"       return () @@ -157,7 +153,7 @@ _test_navigateToStealth_success page =   let     session = do-      () <- navigateToStealth page+      _ <- navigateToStealth $ Text.pack page       assertSuccess "yay"       return () @@ -170,7 +166,7 @@ _test_getCurrentUrl_success =   let     session = do-      !url <- getCurrentUrl+      _ <- getCurrentUrl       assertSuccess "yay"       return () @@ -183,7 +179,9 @@ _test_goBack_success =   let     session = do-      () <- goBack+      _ <- navigateTo "https://example.com"+        -- chromedriver gets cranky if we try to navigate back when there is no history :)+      _ <- goBack       assertSuccess "yay"       return () @@ -196,7 +194,7 @@ _test_goForward_success =   let     session = do-      () <- goForward+      _ <- goForward       assertSuccess "yay"       return () @@ -209,7 +207,7 @@ _test_pageRefresh_success =   let     session = do-      () <- pageRefresh+      _ <- pageRefresh       assertSuccess "yay"       return () @@ -222,7 +220,7 @@ _test_getTitle_success =   let     session = do-      !title <- getTitle+      _ <- getTitle       assertSuccess "yay"       return () @@ -235,7 +233,7 @@ _test_getWindowHandle_success =   let     session = do-      !handle <- getWindowHandle+      _ <- getWindowHandle       assertSuccess "yay"       return () @@ -256,7 +254,7 @@       case hs of         [] -> assertFailure "no window handles"         (!h):_ -> do-          () <- switchToWindow h+          _ <- switchToWindow h           assertSuccess "yay"           return () @@ -269,13 +267,13 @@ _test_getWindowHandles_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !handles <- getWindowHandles       case handles of         [] -> do           assertSuccess "yay"           return ()-        (!x):xs -> do+        _:_ -> do           assertSuccess "yay"           return () @@ -283,13 +281,30 @@   +_test_newWindow_success+  :: (Monad eff) => FilePath -> WebDriverT eff ()+_test_newWindow_success page =+  let+    session = do+      navigateTo $ Text.pack page+      (handle, _) <- newWindow TabContext+      switchToWindow handle+      url <- getCurrentUrl+      assertEqual url "about:blank" "default url"+      assertSuccess "yay"+      return ()++  in  catchError session unexpectedError+++ _test_switchToFrame_success   :: (Monad eff) => FilePath -> WebDriverT eff () _test_switchToFrame_success page =   let     session = do-      navigateTo page-      () <- switchToFrame TopLevelFrame+      navigateTo $ Text.pack page+      _ <- switchToFrame TopLevelFrame       assertSuccess "yay"       return () @@ -302,7 +317,7 @@ _test_switchToParentFrame_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       () <- switchToParentFrame       assertSuccess "yay"       return ()@@ -316,7 +331,7 @@ _test_getWindowRect_success =   let     session = do-      !rect <- getWindowRect+      _ <- getWindowRect       assertSuccess "yay"       return () @@ -329,7 +344,7 @@ _test_setWindowRect_success =   let     session = do-      !rect <- setWindowRect $ Rect+      _ <- setWindowRect $ Rect         { _rectX = 0         , _rectY = 0         , _rectWidth = 640@@ -347,7 +362,7 @@ _test_maximizeWindow_success =   let     session = do-      !rect <- maximizeWindow+      _ <- maximizeWindow       assertSuccess "yay"       return () @@ -360,7 +375,7 @@ _test_minimizeWindow_success =   let     session = do-      !rect <- minimizeWindow+      _ <- minimizeWindow       assertSuccess "yay"       return () @@ -373,7 +388,7 @@ _test_fullscreenWindow_success =   let     session = do-      !rect <- fullscreenWindow+      _ <- fullscreenWindow       assertSuccess "yay"       return () @@ -386,12 +401,12 @@ _test_findElement_success page =   let     session = do-      navigateTo page-      !element <- findElement CssSelector "body"-      !element <- findElement LinkTextSelector "A Link"-      !element <- findElement PartialLinkTextSelector "Link"-      !element <- findElement TagName "body"-      !element <- findElement XPathSelector "*"+      navigateTo $ Text.pack page+      _ <- findElement CssSelector "body"+      _ <- findElement LinkTextSelector "A Link"+      _ <- findElement PartialLinkTextSelector "Link"+      _ <- findElement TagName "body"+      _ <- findElement XPathSelector "*"       assertSuccess "yay"       return () @@ -404,27 +419,27 @@ _test_findElements_success page =   let     session = do-      navigateTo page-      !elements <- findElements CssSelector "body"-      case elements of+      navigateTo $ Text.pack page+      !e0 <- findElements CssSelector "body"+      case e0 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElements LinkTextSelector "Standards"-      case elements of+        _:_ -> return ()+      !e1 <- findElements LinkTextSelector "Standards"+      case e1 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElements PartialLinkTextSelector "Standards"-      case elements of+        _:_ -> return ()+      !e2 <- findElements PartialLinkTextSelector "Standards"+      case e2 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElements TagName "body"-      case elements of+        _:_ -> return ()+      !e3 <- findElements TagName "body"+      case e3 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElements XPathSelector "*"-      case elements of+        _:_ -> return ()+      !e4 <- findElements XPathSelector "*"+      case e4 of         [] -> return ()-        (!x):xs -> return ()+        _:_ -> return ()       assertSuccess "yay"       return () @@ -437,13 +452,13 @@ _test_findElementFromElement_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       root <- findElement CssSelector "body"-      !element <- findElementFromElement CssSelector "p" root-      !element <- findElementFromElement LinkTextSelector "A Link" root-      !element <- findElementFromElement PartialLinkTextSelector "Link" root-      !element <- findElementFromElement TagName "p" root-      !element <- findElementFromElement XPathSelector "*" root+      _ <- findElementFromElement CssSelector "p" root+      _ <- findElementFromElement LinkTextSelector "A Link" root+      _ <- findElementFromElement PartialLinkTextSelector "Link" root+      _ <- findElementFromElement TagName "p" root+      _ <- findElementFromElement XPathSelector "*" root       assertSuccess "yay"       return () @@ -456,28 +471,28 @@ _test_findElementsFromElement_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       root <- findElement CssSelector "body"-      !elements <- findElementsFromElement CssSelector "p" root-      case elements of+      !e0 <- findElementsFromElement CssSelector "p" root+      case e0 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElementsFromElement LinkTextSelector "Standards" root-      case elements of+        _:_ -> return ()+      !e1 <- findElementsFromElement LinkTextSelector "Standards" root+      case e1 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElementsFromElement PartialLinkTextSelector "Standards" root-      case elements of+        _:_ -> return ()+      !e2 <- findElementsFromElement PartialLinkTextSelector "Standards" root+      case e2 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElementsFromElement TagName "p" root-      case elements of+        _:_ -> return ()+      !e3 <- findElementsFromElement TagName "p" root+      case e3 of         [] -> return ()-        (!x):xs -> return ()-      !elements <- findElementsFromElement XPathSelector "*" root-      case elements of+        _:_ -> return ()+      !e4 <- findElementsFromElement XPathSelector "*" root+      case e4 of         [] -> return ()-        (!x):xs -> return ()+        _:_ -> return ()       assertSuccess "yay"       return () @@ -490,7 +505,7 @@ _test_getActiveElement_success =   let     session = do-      !element <- getActiveElement+      _ <- getActiveElement       assertSuccess "yay"       return () @@ -503,9 +518,9 @@ _test_isElementSelected_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- getActiveElement-      !p <- isElementSelected element+      _ <- isElementSelected element       assertSuccess "yay"       return () @@ -518,9 +533,9 @@ _test_getElementAttribute_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- getActiveElement-      !attr <- getElementAttribute "href" element+      _ <- getElementAttribute "href" element       assertSuccess "yay"       return () @@ -537,12 +552,17 @@ _test_getElementCssValue_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "p#super-cool"       !text <- getElementCssValue "text-decoration" element       case text of         "none" -> assertSuccess "yay"-        _ -> assertFailure $ AssertionComment $ "expected 'none', got '" ++ text ++ "'"+        "rgb(0, 0, 0)" -> assertSuccess "yay"+        "none solid rgb(0, 0, 0)" -> assertSuccess "yay"+        _ -> assertFailure $ AssertionComment $ mconcat+          [ "expected 'none' or 'rgb(0, 0, 0)' or 'none solid rgb(0, 0, 0)', got '"+          , text, "'"+          ]       return ()    in  catchError session unexpectedError@@ -554,9 +574,9 @@ _test_getElementText_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- getActiveElement-      !text <- getElementText element+      _ <- getElementText element       assertSuccess "yay"       return () @@ -569,12 +589,13 @@ _test_getElementTagName_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "div.test"       !text <- getElementTagName element       case text of         "div" -> assertSuccess "yay"-        _ -> assertFailure $ AssertionComment $ "expected 'div', got '" ++ text ++ "'"+        _ -> assertFailure $ AssertionComment $+          "expected 'div', got '" <> text <> "'"       return ()    in  catchError session unexpectedError@@ -586,9 +607,9 @@ _test_getElementRect_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- getActiveElement-      !rect <- getElementRect element+      _ <- getElementRect element       assertSuccess "yay"       return () @@ -601,9 +622,9 @@ _test_isElementEnabled_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- getActiveElement-      !p <- isElementEnabled element+      _ <- isElementEnabled element       assertSuccess "yay"       return () @@ -611,14 +632,44 @@   +_test_getComputedRole_success+  :: (Monad eff) => FilePath -> WebDriverT eff ()+_test_getComputedRole_success page =+  let+    session = do+      navigateTo $ Text.pack page+      !element <- getActiveElement+      _ <- getComputedRole element+      assertSuccess "yay"+      return ()++  in catchError session unexpectedError++++_test_getComputedLabel_success+  :: (Monad eff) => FilePath -> WebDriverT eff ()+_test_getComputedLabel_success page =+  let+    session = do+      navigateTo $ Text.pack page+      !element <- getActiveElement+      _ <- getComputedLabel element+      assertSuccess "yay"+      return ()++  in catchError session unexpectedError+++ _test_elementClick_success   :: (Monad eff) => FilePath -> WebDriverT eff () _test_elementClick_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !root <- findElement CssSelector "body"-      () <- elementClick root+      _ <- elementClick root       assertSuccess "yay"       return () @@ -631,9 +682,9 @@ _test_elementClear_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "input[name='sometext']"-      () <- elementClear element+      _ <- elementClear element       assertSuccess "yay"       return () @@ -646,9 +697,9 @@ _test_elementSendKeys_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "input[name='sometext']"-      () <- elementSendKeys "foo" element+      _ <- elementSendKeys "foo" element       assertSuccess "yay"       return () @@ -661,8 +712,8 @@ _test_getPageSource_success page =   let     session = do-      navigateTo page-      !src <- getPageSource+      navigateTo $ Text.pack page+      _ <- getPageSource       assertSuccess "yay"       return () @@ -675,8 +726,8 @@ _test_getPageSourceStealth_success page =   let     session = do-      navigateTo page-      !src <- getPageSourceStealth+      navigateTo $ Text.pack page+      _ <- getPageSourceStealth       assertSuccess "yay"       return () @@ -697,11 +748,11 @@ _test_getAllCookies_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !jar <- getAllCookies       case jar of         [] -> assertSuccess "yay"-        (!x):_ -> assertFailure "unexpected cookie"+        _:_ -> assertFailure "unexpected cookie"       return ()    in  catchError session unexpectedError@@ -713,11 +764,11 @@ _test_getNamedCookie_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#add-cookie-button" >>= elementClick-      !cookie <- getNamedCookie "fakeCookie"-      assertEqual (_cookieName cookie) (Just "fakeCookie") "cookie name"-      assertEqual (_cookieValue cookie) (Just "fakeValue") "cookie name"+      !c <- getNamedCookie "fakeCookie"+      assertEqual (_cookieName c) (Just "fakeCookie") "cookie name"+      assertEqual (_cookieValue c) (Just "fakeValue") "cookie name"       return ()    in  catchError session unexpectedError@@ -734,7 +785,7 @@ _test_deleteCookie_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#add-cookie-button" >>= elementClick       () <- deleteCookie "fakeCookie"       assertSuccess "yay"@@ -837,7 +888,7 @@ _test_dismissAlert_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#alert-button" >>= elementClick       () <- dismissAlert       assertSuccess "yay alert"@@ -858,7 +909,7 @@ _test_acceptAlert_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#alert-button" >>= elementClick       () <- acceptAlert       assertSuccess "yay alert"@@ -879,22 +930,22 @@ _test_getAlertText_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#alert-button" >>= elementClick-      !box <- getAlertText-      case box of+      !box0 <- getAlertText+      case box0 of         Nothing -> assertFailure "oh no alert"         Just msg -> assertEqual msg "WOO!!" "alert text"       acceptAlert       findElement CssSelector "button#confirm-button" >>= elementClick-      !box <- getAlertText-      case box of+      !box1 <- getAlertText+      case box1 of         Nothing -> assertFailure "oh no confirm"         Just msg -> assertEqual msg "WOO!!" "confirm text"       acceptAlert       findElement CssSelector "button#prompt-button" >>= elementClick-      !box <- getAlertText-      case box of+      !box2 <- getAlertText+      case box2 of         Nothing -> assertFailure "oh no prompt"         Just msg -> assertEqual msg "WOO!!" "prompt text"       acceptAlert@@ -909,7 +960,7 @@ _test_sendAlertText_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       findElement CssSelector "button#prompt-button" >>= elementClick       () <- sendAlertText "wut"       assertSuccess "yay prompt"@@ -924,8 +975,8 @@ _test_takeScreenshot_success page =   let     session = do-      navigateTo page-      !screenshot <- takeScreenshot+      navigateTo $ Text.pack page+      _ <- takeScreenshot       assertSuccess "yay"       return () @@ -938,9 +989,23 @@ _test_takeElementScreenshot_success page =   let     session = do-      navigateTo page+      navigateTo $ Text.pack page       !element <- findElement CssSelector "body"-      !screenshot <- takeElementScreenshot element+      _ <- takeElementScreenshot element+      assertSuccess "yay"+      return ()++  in catchError session unexpectedError++++_test_printPage_success+  :: (Monad eff) => FilePath -> WebDriverT eff ()+_test_printPage_success page =+  let+    session = do+      navigateTo $ Text.pack page+      _ <- printPage defaultPrintOptions       assertSuccess "yay"       return () 

@@ -3,7 +3,6 @@     unknownErrorExit   ) where -import Data.Typeable (Typeable) import System.IO  import Web.Api.WebDriver@@ -27,8 +26,7 @@   -> FilePath   -> T.TestTree unknownErrorExit buildTestCase path = T.testGroup "Unknown Error"-  [ ifDriverIs Chromedriver TE.ignoreTest $-      buildTestCase "navigateTo" (_test_navigateTo_unknown_error)+  [ buildTestCase "navigateTo" (_test_navigateTo_unknown_error)   ]  @@ -39,7 +37,7 @@   let     session = do       navigateTo "https://fake.example"-      throwError $ UnexpectedResult IsSuccess "Expecting 'unknown error'"+      _ <- throwError $ UnexpectedResult IsSuccess "Expecting 'unknown error'"       return ()    in catchError session unknownError

@@ -6,8 +6,6 @@ import Data.Proxy import qualified Data.Aeson as A   ( ToJSON(..), FromJSON, fromJSON, Result(..), object, Value(..) )-import Test.QuickCheck-  ( quickCheck, Arbitrary(..), label, Property )  import Test.Tasty (TestTree(), testGroup) import Test.Tasty.QuickCheck as QC (testProperty)@@ -96,6 +94,30 @@    , QC.testProperty "(ResponseErrorCode) fromJSON . toJSON == id" $       (prop_fromJson_toJson_id :: ResponseErrorCode -> Bool)++  , QC.testProperty "(ContextId) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ContextId -> Bool)++  , QC.testProperty "(ContextType) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: ContextType -> Bool)++  , QC.testProperty "(PrintOptions) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: PrintOptions -> Bool)++  , QC.testProperty "(Orientation) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Orientation -> Bool)++  , QC.testProperty "(Scale) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Scale -> Bool)++  , QC.testProperty "(Page) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Page -> Bool)++  , QC.testProperty "(Margin) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: Margin -> Bool)++  , QC.testProperty "(PageRange) fromJSON . toJSON == id" $+      (prop_fromJson_toJson_id :: PageRange -> Bool)   ]  @@ -136,9 +158,9 @@   => Proxy a -> A.Value -> IO () prop_fromJson_parse_error x str =   case A.fromJSON str of-    A.Error !err -> return ()+    A.Error !_ -> return ()     A.Success !y -> do-      let z = asProxyTypeOf y x+      let _ = asProxyTypeOf y x       assertFailure $ "Expected parse failure!"  test_fromJson_parse_error :: TestTree

@@ -1,5 +1,5 @@ name:           webdriver-w3c-version:        0.0.2+version:        0.0.3 description:    Please see the README on Github at <https://github.com/nbloomf/webdriver-w3c#readme> homepage:       https://github.com/nbloomf/webdriver-w3c#readme bug-reports:    https://github.com/nbloomf/webdriver-w3c/issues@@ -30,7 +30,7 @@     -fwarn-incomplete-patterns    build-depends:-      base >=4.7 && <5+      base >=4.12 && <5      , aeson >=1.2.4.0     , aeson-pretty >=0.8.5@@ -48,7 +48,7 @@     , QuickCheck >=2.10.1     , random >=1.1     , scientific >=0.3.5.2-    , script-monad >=0.0.1+    , script-monad >=0.0.3     , SHA >=1.6.4.2     , stm >=2.4.5.0     , tasty >=1.0.1.1@@ -88,6 +88,7 @@      , tasty >=1.0.1.1     , transformers >=0.5.5.0+    , text >=1.2.3.0   @@ -100,6 +101,7 @@       webdriver-w3c     , base >=4.7 && <5 +    , text >=1.2.3.0     , tasty >=1.0.1.1     , tasty-expected-failure >=0.11.1.1 @@ -114,6 +116,21 @@       webdriver-w3c     , base >=4.7 && <5 +    , text >=1.2.3.0+    , tasty >=1.0.1.1++++executable wd-repl-demo+  default-language: Haskell2010+  main-is: ReplDemo.hs+  hs-source-dirs: app+  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      webdriver-w3c+    , base >=4.7 && <5++    , text >=1.2.3.0     , tasty >=1.0.1.1