{- |
Module      : Web.Api.WebDriver.Monad
Description : A WebDriver session monad.
Copyright   : 2018, Automattic, Inc.
License     : GPL-3
Maintainer  : Nathan Bloomfield (nbloomf@gmail.com)
Stability   : experimental
Portability : POSIX

A monad transformer for building WebDriver sessions.
-}

{-#
  LANGUAGE
    CPP,
    GADTs,
    Rank2Types,
    KindSignatures,
    RecordWildCards,
    OverloadedStrings
#-}

module Web.Api.WebDriver.Monad (
    WebDriverT
  , execWebDriverT
  , debugWebDriverT
  , checkWebDriverT

  , WebDriverTT()
  , execWebDriverTT
  , debugWebDriverTT
  , checkWebDriverTT
  , liftWebDriverTT

  , evalWDAct
  , Http.evalIO
  , evalWDActMockIO
  , Http.evalMockIO

  -- * Config
  , WebDriverConfig(..)
  , defaultWebDriverConfig
  , defaultWebDriverState
  , defaultWebDriverEnvironment
  , defaultWDEnv
  , defaultWebDriverLogOptions

  -- * API
  , fromState
  , modifyState
  , fromEnv
  , comment
  , wait
  , logDebug
  , logNotice
  , throwError
  , throwJsonError
  , throwHttpException
  , throwIOException
  , expect
  , expectIs
  , assert
  , catchError
  , catchJsonError
  , catchHttpException
  , catchIOException
  , catchAnyError
  , parseJson
  , lookupKeyJson
  , constructFromJson
  , httpGet
  , httpSilentGet
  , httpPost
  , httpSilentPost
  , httpDelete
  , httpSilentDelete
  , hPutStrLn
  , hPutStrLnBlocking
  , getStrLn
  , promptForString
  , promptForSecret
  , readFilePath
  , writeFilePath
  , fileExists
  , breakpointsOn
  , breakpointsOff
  , breakpoint
  , breakpointWith

  -- * Types
  , Http.E()
  , Http.JsonError(..)
  , WDError(..)
  , Http.R(..)
  , Http.LogOptions(..)
  , WDEnv(..)
  , ResponseFormat(..)
  , ApiVersion(..)
  , Outcome(..)
  , Http.Url
  , Http.HttpResponse(..)
  , WDLog(..)
  , Http.P(..)
  , WDAct(..)
  , Http.S(..)
  , WDState(..)
  , BreakpointSetting(..)

  -- * Logs
  , getAssertions
  , Http.logEntries
  , Http.printHttpLogs
  , Http.basicLogEntryPrinter
) where



#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 )
import Control.Exception
  ( IOException, try )
import Control.Lens
  ( (^.), (^?) )
import Control.Monad
  ( ap )
import Control.Monad.IO.Class
  ( MonadIO(..) )
import Control.Monad.Trans.Class
  ( MonadTrans(..) )
import Control.Monad.Trans.Identity
  ( IdentityT(..) )
import Data.Aeson
  ( Value(), Result(Success), toJSON, (.=), FromJSON, fromJSON, object )
import Data.Aeson.Encode.Pretty
  ( encodePretty )
import Data.Aeson.Lens
  ( key, _Value, _String )
import qualified Data.ByteString.Char8 as SC
  ( unpack )
import Data.ByteString.Lazy
  ( ByteString, readFile, writeFile, toStrict, fromStrict )
import qualified Data.ByteString.Lazy.Char8 as LC
  ( unpack, pack )
import Data.List
  ( intercalate )
import Data.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
  ( Status, statusMessage, statusCode, responseStatus, defaults )
import System.Directory
  ( doesFileExist )
import System.IO
  ( 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

import Web.Api.WebDriver.Types
import Web.Api.WebDriver.Assert





-- | Wrapper type around `Http.HttpTT`; a stack of error, reader, writer, state, and prompt monad transformers.
newtype WebDriverTT
  (t :: (* -> *) -> * -> *)
  (eff :: * -> *)
  (a :: *)
  = WDT
    { WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT :: Http.HttpTT WDError WDEnv WDLog WDState WDAct t eff a }

instance
  (Monad eff, Monad (t eff), MonadTrans t)
    => Functor (WebDriverTT t eff) where
  fmap :: (a -> b) -> WebDriverTT t eff a -> WebDriverTT t eff b
fmap a -> b
f = HttpTT WDError WDEnv WDLog WDState WDAct t eff b
-> WebDriverTT t eff b
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff b
 -> WebDriverTT t eff b)
-> (WebDriverTT t eff a
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff b)
-> WebDriverTT t eff a
-> WebDriverTT t eff b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff b)
-> (WebDriverTT t eff a
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT

instance
  (Monad eff, Monad (t eff), MonadTrans t)
    => Applicative (WebDriverTT t eff) where
  pure :: a -> WebDriverTT t eff a
pure = a -> WebDriverTT t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return
  <*> :: WebDriverTT t eff (a -> b)
-> WebDriverTT t eff a -> WebDriverTT t eff b
(<*>) = WebDriverTT t eff (a -> b)
-> WebDriverTT t eff a -> WebDriverTT t eff b
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
ap

instance
  (Monad eff, Monad (t eff), MonadTrans t)
    => Monad (WebDriverTT t eff) where
  return :: a -> WebDriverTT t eff a
return = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> a
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return
  (WDT HttpTT WDError WDEnv WDLog WDState WDAct t eff a
x) >>= :: WebDriverTT t eff a
-> (a -> WebDriverTT t eff b) -> WebDriverTT t eff b
>>= a -> WebDriverTT t eff b
f = HttpTT WDError WDEnv WDLog WDState WDAct t eff b
-> WebDriverTT t eff b
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
x HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff b)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (WebDriverTT t eff b
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff b
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff b
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff b)
-> (a -> WebDriverTT t eff b)
-> a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> WebDriverTT t eff b
f))

instance
  (MonadIO eff, MonadIO (t eff), MonadTrans t)
    => MonadIO (WebDriverTT t eff) where
  liftIO :: IO a -> WebDriverTT t eff a
liftIO = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (IO a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> IO a
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t eff a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
t eff a -> HttpTT e r w s p t eff a
Http.liftHttpTT (t eff a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (IO a -> t eff a)
-> IO a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> t eff a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

instance
  (Monad eff, MonadTrans t, Monad (t eff), MonadFail (t eff))
    => MonadFail (WebDriverTT t eff) where
  fail :: String -> WebDriverTT t eff a
fail = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (String -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> String
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail

-- | Lift a value from the inner transformed monad
liftWebDriverTT
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => t eff a -> WebDriverTT t eff a
liftWebDriverTT :: t eff a -> WebDriverTT t eff a
liftWebDriverTT = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (t eff a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> t eff a
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t eff a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
t eff a -> HttpTT e r w s p t eff a
Http.liftHttpTT

-- | Type representing configuration settings for a WebDriver session
data WebDriverConfig eff = WDConfig
  { WebDriverConfig eff -> S WDState
_initialState :: Http.S WDState
  , WebDriverConfig eff -> R WDError WDLog WDEnv
_environment :: Http.R WDError WDLog WDEnv
  , WebDriverConfig eff -> forall a. P WDAct a -> eff a
_evaluator :: forall a. Http.P WDAct a -> eff a
  }

-- | Default `IO` effects
defaultWebDriverConfig :: WebDriverConfig IO
defaultWebDriverConfig :: WebDriverConfig IO
defaultWebDriverConfig = WDConfig :: forall (eff :: * -> *).
S WDState
-> R WDError WDLog WDEnv
-> (forall a. P WDAct a -> eff a)
-> WebDriverConfig eff
WDConfig
  { _initialState :: S WDState
_initialState = S WDState
defaultWebDriverState
  , _environment :: R WDError WDLog WDEnv
_environment = R WDError WDLog WDEnv
defaultWebDriverEnvironment
  , _evaluator :: forall a. P WDAct a -> IO a
_evaluator = (WDAct a -> IO a) -> P WDAct a -> IO a
forall (p :: * -> *) a. (p a -> IO a) -> P p a -> IO a
Http.evalIO WDAct a -> IO a
forall a. WDAct a -> IO a
evalWDAct
  }

defaultWebDriverState :: Http.S WDState
defaultWebDriverState :: S WDState
defaultWebDriverState = S :: forall s. Options -> Maybe Session -> s -> S s
Http.S
  { _httpOptions :: Options
Http._httpOptions = Options
defaults
  , _httpSession :: Maybe Session
Http._httpSession = Maybe Session
forall a. Maybe a
Nothing
  , _userState :: WDState
Http._userState = WDState :: Maybe Text -> BreakpointSetting -> WDState
WDState
    { _sessionId :: Maybe Text
_sessionId = Maybe Text
forall a. Maybe a
Nothing
    , _breakpoints :: BreakpointSetting
_breakpoints = BreakpointSetting
BreakpointsOff
    }
  }

defaultWebDriverEnvironment :: Http.R WDError WDLog WDEnv
defaultWebDriverEnvironment :: R WDError WDLog WDEnv
defaultWebDriverEnvironment = R :: forall e w r.
LogOptions e w
-> (LogOptions e w -> LogEntry e w -> Maybe Text)
-> Handle
-> Maybe (MVar ())
-> Text
-> (HttpException -> Maybe e)
-> r
-> R e w r
Http.R
  { _logHandle :: Handle
Http._logHandle = Handle
stdout
  , _logLock :: Maybe (MVar ())
Http._logLock = Maybe (MVar ())
forall a. Maybe a
Nothing
  , _logEntryPrinter :: LogOptions WDError WDLog -> LogEntry WDError WDLog -> Maybe Text
Http._logEntryPrinter = LogOptions WDError WDLog -> LogEntry WDError WDLog -> Maybe Text
forall e w. LogOptions e w -> LogEntry e w -> Maybe Text
Http.basicLogEntryPrinter
  , _uid :: Text
Http._uid = Text
""
  , _logOptions :: LogOptions WDError WDLog
Http._logOptions = LogOptions WDError WDLog
defaultWebDriverLogOptions
  , _httpErrorInject :: HttpException -> Maybe WDError
Http._httpErrorInject = HttpException -> Maybe WDError
promoteHttpResponseError
  , _env :: WDEnv
Http._env = WDEnv
defaultWDEnv
  }

-- | Uses default geckodriver settings
defaultWDEnv :: WDEnv
defaultWDEnv :: WDEnv
defaultWDEnv = WDEnv :: Text
-> Int
-> Text
-> String
-> ResponseFormat
-> ApiVersion
-> Handle
-> Handle
-> WDEnv
WDEnv
  { _remoteHostname :: Text
_remoteHostname = Text
"localhost"
  , _remotePort :: Int
_remotePort = Int
4444
  , _remotePath :: Text
_remotePath = Text
""
  , _dataPath :: String
_dataPath = String
""
  , _responseFormat :: ResponseFormat
_responseFormat = ResponseFormat
SpecFormat
  , _apiVersion :: ApiVersion
_apiVersion = ApiVersion
CR_2018_03_04
  , _stdin :: Handle
_stdin = Handle
stdin
  , _stdout :: Handle
_stdout = Handle
stdout
  }

-- | Noisy, JSON, in color, without headers.
defaultWebDriverLogOptions :: Http.LogOptions WDError WDLog
defaultWebDriverLogOptions :: LogOptions WDError WDLog
defaultWebDriverLogOptions = LogOptions Any Any
forall e w. LogOptions e w
Http.trivialLogOptions
  { _logColor :: Bool
Http._logColor = Bool
True
  , _logJson :: Bool
Http._logJson = Bool
True
  , _logHeaders :: Bool
Http._logHeaders = Bool
False
  , _logSilent :: Bool
Http._logSilent = Bool
False
  , _printUserError :: Bool -> WDError -> Text
Http._printUserError = Bool -> WDError -> Text
printWDError
  , _printUserLog :: Bool -> WDLog -> Text
Http._printUserLog = Bool -> WDLog -> Text
printWDLog
  }



-- | Execute a `WebDriverTT` session.
execWebDriverTT
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverConfig eff
  -> WebDriverTT t eff a
  -> t eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog)
execWebDriverTT :: WebDriverConfig eff
-> WebDriverTT t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
execWebDriverTT WebDriverConfig eff
config = S WDState
-> R WDError WDLog WDEnv
-> (forall u. P WDAct u -> eff u)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s e w r
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
S s
-> R e w r
-> (forall u. P p u -> eff u)
-> HttpTT e r w s p t eff a
-> t eff (Either (E e) a, S s, W e w)
Http.execHttpTT
  (WebDriverConfig eff -> S WDState
forall (eff :: * -> *). WebDriverConfig eff -> S WDState
_initialState WebDriverConfig eff
config) (WebDriverConfig eff -> R WDError WDLog WDEnv
forall (eff :: * -> *).
WebDriverConfig eff -> R WDError WDLog WDEnv
_environment WebDriverConfig eff
config) (WebDriverConfig eff -> forall u. P WDAct u -> eff u
forall (eff :: * -> *).
WebDriverConfig eff -> forall a. P WDAct a -> eff a
_evaluator WebDriverConfig eff
config) (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> t eff (Either (E WDError) a, S WDState, W WDError WDLog))
-> (WebDriverTT t eff a
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> WebDriverTT t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT

-- | Execute a `WebDriverTT` session, returning an assertion summary with the result.
debugWebDriverTT
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverConfig eff
  -> WebDriverTT t eff a
  -> t eff (Either Text a, AssertionSummary)
debugWebDriverTT :: WebDriverConfig eff
-> WebDriverTT t eff a -> t eff (Either Text a, AssertionSummary)
debugWebDriverTT WebDriverConfig eff
config WebDriverTT t eff a
session = do
  (Either (E WDError) a
result, S WDState
_, W WDError WDLog
w) <- WebDriverConfig eff
-> WebDriverTT t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverConfig eff
-> WebDriverTT t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
execWebDriverTT WebDriverConfig eff
config WebDriverTT t eff a
session
  let output :: Either Text a
output = case Either (E WDError) a
result of
        Right a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
        Left E WDError
e -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ (WDError -> Text) -> E WDError -> Text
forall e. (e -> Text) -> E e -> Text
Http.printError (Bool -> WDError -> Text
printWDError Bool
True) E WDError
e
  (Either Text a, AssertionSummary)
-> t eff (Either Text a, AssertionSummary)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a
output, [Assertion] -> AssertionSummary
summarize ([Assertion] -> AssertionSummary)
-> [Assertion] -> AssertionSummary
forall a b. (a -> b) -> a -> b
$ [WDLog] -> [Assertion]
getAssertions ([WDLog] -> [Assertion]) -> [WDLog] -> [Assertion]
forall a b. (a -> b) -> a -> b
$ W WDError WDLog -> [WDLog]
forall e w. W e w -> [w]
Http.logEntries W WDError WDLog
w)

-- | For testing with QuickCheck.
checkWebDriverTT
  :: (Monad eff, Monad (t eff), MonadTrans t, Show q)
  => WebDriverConfig eff
  -> (t eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO`
  -> (q -> Bool) -- ^ Result check
  -> WebDriverTT t eff a
  -> Property
checkWebDriverTT :: WebDriverConfig eff
-> (t eff (Either (E WDError) a, S WDState, W WDError WDLog)
    -> IO q)
-> (q -> Bool)
-> WebDriverTT t eff a
-> Property
checkWebDriverTT WebDriverConfig eff
config t eff (Either (E WDError) a, S WDState, W WDError WDLog) -> IO q
cond q -> Bool
check =
  S WDState
-> R WDError WDLog WDEnv
-> (forall u. P WDAct u -> eff u)
-> (t eff (Either (E WDError) a, S WDState, W WDError WDLog)
    -> IO q)
-> (q -> Bool)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> Property
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) q e r w s
       (p :: * -> *) a prop.
(Monad eff, Monad (t eff), MonadTrans t, Show q, Testable prop) =>
S s
-> R e w r
-> (forall u. P p u -> eff u)
-> (t eff (Either (E e) a, S s, W e w) -> IO q)
-> (q -> prop)
-> HttpTT e r w s p t eff a
-> Property
Http.checkHttpTT
    (WebDriverConfig eff -> S WDState
forall (eff :: * -> *). WebDriverConfig eff -> S WDState
_initialState WebDriverConfig eff
config)
    (WebDriverConfig eff -> R WDError WDLog WDEnv
forall (eff :: * -> *).
WebDriverConfig eff -> R WDError WDLog WDEnv
_environment WebDriverConfig eff
config)
    (WebDriverConfig eff -> forall u. P WDAct u -> eff u
forall (eff :: * -> *).
WebDriverConfig eff -> forall a. P WDAct a -> eff a
_evaluator WebDriverConfig eff
config)
    t eff (Either (E WDError) a, S WDState, W WDError WDLog) -> IO q
cond q -> Bool
check (HttpTT WDError WDEnv WDLog WDState WDAct t eff a -> Property)
-> (WebDriverTT t eff a
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> WebDriverTT t eff a
-> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT





-- | `WebDriverTT` over `IdentityT`.
type WebDriverT eff a = WebDriverTT IdentityT eff a



-- | Execute a `WebDriverT` session.
execWebDriverT
  :: (Monad eff)
  => WebDriverConfig eff
  -> WebDriverT eff a
  -> eff (Either (Http.E WDError) a, Http.S WDState, Http.W WDError WDLog)
execWebDriverT :: WebDriverConfig eff
-> WebDriverT eff a
-> eff (Either (E WDError) a, S WDState, W WDError WDLog)
execWebDriverT WebDriverConfig eff
config = IdentityT eff (Either (E WDError) a, S WDState, W WDError WDLog)
-> eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (IdentityT eff (Either (E WDError) a, S WDState, W WDError WDLog)
 -> eff (Either (E WDError) a, S WDState, W WDError WDLog))
-> (WebDriverT eff a
    -> IdentityT
         eff (Either (E WDError) a, S WDState, W WDError WDLog))
-> WebDriverT eff a
-> eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WebDriverConfig eff
-> WebDriverT eff a
-> IdentityT eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverConfig eff
-> WebDriverTT t eff a
-> t eff (Either (E WDError) a, S WDState, W WDError WDLog)
execWebDriverTT WebDriverConfig eff
config

-- | Execute a `WebDriverT` session, returning an assertion summary with the result.
debugWebDriverT
  :: (Monad eff)
  => WebDriverConfig eff
  -> WebDriverT eff a
  -> eff (Either Text a, AssertionSummary)
debugWebDriverT :: WebDriverConfig eff
-> WebDriverT eff a -> eff (Either Text a, AssertionSummary)
debugWebDriverT WebDriverConfig eff
config WebDriverT eff a
session = do
  (Either (E WDError) a
result, S WDState
_, W WDError WDLog
w) <- WebDriverConfig eff
-> WebDriverT eff a
-> eff (Either (E WDError) a, S WDState, W WDError WDLog)
forall (eff :: * -> *) a.
Monad eff =>
WebDriverConfig eff
-> WebDriverT eff a
-> eff (Either (E WDError) a, S WDState, W WDError WDLog)
execWebDriverT WebDriverConfig eff
config WebDriverT eff a
session
  let output :: Either Text a
output = case Either (E WDError) a
result of
        Right a
a -> a -> Either Text a
forall a b. b -> Either a b
Right a
a
        Left E WDError
e -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a) -> Text -> Either Text a
forall a b. (a -> b) -> a -> b
$ (WDError -> Text) -> E WDError -> Text
forall e. (e -> Text) -> E e -> Text
Http.printError (Bool -> WDError -> Text
printWDError Bool
True) E WDError
e
  (Either Text a, AssertionSummary)
-> eff (Either Text a, AssertionSummary)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Text a
output, [Assertion] -> AssertionSummary
summarize ([Assertion] -> AssertionSummary)
-> [Assertion] -> AssertionSummary
forall a b. (a -> b) -> a -> b
$ [WDLog] -> [Assertion]
getAssertions ([WDLog] -> [Assertion]) -> [WDLog] -> [Assertion]
forall a b. (a -> b) -> a -> b
$ W WDError WDLog -> [WDLog]
forall e w. W e w -> [w]
Http.logEntries W WDError WDLog
w)

-- | For testing with QuickCheck
checkWebDriverT
  :: (Monad eff, Show q)
  => WebDriverConfig eff
  -> (eff (Either (Http.E WDError) t, Http.S WDState, Http.W WDError WDLog) -> IO q) -- ^ Condense to `IO`
  -> (q -> Bool) -- ^ Result check
  -> WebDriverT eff t
  -> Property
checkWebDriverT :: WebDriverConfig eff
-> (eff (Either (E WDError) t, S WDState, W WDError WDLog) -> IO q)
-> (q -> Bool)
-> WebDriverT eff t
-> Property
checkWebDriverT WebDriverConfig eff
config eff (Either (E WDError) t, S WDState, W WDError WDLog) -> IO q
cond = WebDriverConfig eff
-> (IdentityT
      eff (Either (E WDError) t, S WDState, W WDError WDLog)
    -> IO q)
-> (q -> Bool)
-> WebDriverT eff t
-> Property
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) q a.
(Monad eff, Monad (t eff), MonadTrans t, Show q) =>
WebDriverConfig eff
-> (t eff (Either (E WDError) a, S WDState, W WDError WDLog)
    -> IO q)
-> (q -> Bool)
-> WebDriverTT t eff a
-> Property
checkWebDriverTT WebDriverConfig eff
config (eff (Either (E WDError) t, S WDState, W WDError WDLog) -> IO q
cond (eff (Either (E WDError) t, S WDState, W WDError WDLog) -> IO q)
-> (IdentityT
      eff (Either (E WDError) t, S WDState, W WDError WDLog)
    -> eff (Either (E WDError) t, S WDState, W WDError WDLog))
-> IdentityT eff (Either (E WDError) t, S WDState, W WDError WDLog)
-> IO q
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IdentityT eff (Either (E WDError) t, S WDState, W WDError WDLog)
-> eff (Either (E WDError) t, S WDState, W WDError WDLog)
forall k (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT)



-- | Get a computed value from the state
fromState
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => (Http.S WDState -> a) -> WebDriverTT t eff a
fromState :: (S WDState -> a) -> WebDriverTT t eff a
fromState = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> ((S WDState -> a)
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (S WDState -> a)
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S WDState -> a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s a e r w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
(S s -> a) -> HttpTT e r w s p t eff a
Http.gets

-- | Mutate the state
modifyState
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => (Http.S WDState -> Http.S WDState) -> WebDriverTT t eff ()
modifyState :: (S WDState -> S WDState) -> WebDriverTT t eff ()
modifyState = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> ((S WDState -> S WDState)
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> (S WDState -> S WDState)
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (S WDState -> S WDState)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) s e r w
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
(S s -> S s) -> HttpTT e r w s p t eff ()
Http.modify

-- | Get a computed value from the environment
fromEnv
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => (Http.R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv :: (R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> ((R WDError WDLog WDEnv -> a)
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (R WDError WDLog WDEnv -> a)
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (R WDError WDLog WDEnv -> a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e w r a s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
(R e w r -> a) -> HttpTT e r w s p t eff a
Http.reader

logDebug
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WDLog -> WebDriverTT t eff ()
logDebug :: WDLog -> WebDriverTT t eff ()
logDebug = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (WDLog -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> WDLog
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDLog -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) w e r s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
w -> HttpTT e r w s p t eff ()
Http.logDebug

logNotice
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WDLog -> WebDriverTT t eff ()
logNotice :: WDLog -> WebDriverTT t eff ()
logNotice = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (WDLog -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> WDLog
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDLog -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) w e r s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
w -> HttpTT e r w s p t eff ()
Http.logNotice

-- | Write a comment to the log.
comment
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -> WebDriverTT t eff ()
comment :: Text -> WebDriverTT t eff ()
comment = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> Text
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> HttpTT e r w s p t eff ()
Http.comment

-- | Suspend the current session. Handy when waiting for pages to load.
wait
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Int -- ^ Wait time in milliseconds
  -> WebDriverTT t eff ()
wait :: Int -> WebDriverTT t eff ()
wait = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (Int -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> Int
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Int -> HttpTT e r w s p t eff ()
Http.wait

throwError
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WDError -> WebDriverTT t eff a
throwError :: WDError -> WebDriverTT t eff a
throwError = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (WDError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> WDError
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
e -> HttpTT e r w s p t eff a
Http.throwError

throwJsonError
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.JsonError -> WebDriverTT t eff a
throwJsonError :: JsonError -> WebDriverTT t eff a
throwJsonError = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (JsonError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> JsonError
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
JsonError -> HttpTT e r w s p t eff a
Http.throwJsonError

throwHttpException
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => N.HttpException -> WebDriverTT t eff a
throwHttpException :: HttpException -> WebDriverTT t eff a
throwHttpException = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (HttpException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpException
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpException -> HttpTT e r w s p t eff a
Http.throwHttpException

throwIOException
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => IOException -> WebDriverTT t eff a
throwIOException :: IOException -> WebDriverTT t eff a
throwIOException = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (IOException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> IOException
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> HttpTT e r w s p t eff a
Http.throwIOException

-- | Explicitly handle any of the error types thrown in `WebDriverTT`
catchAnyError
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff a
  -> (WDError -> WebDriverTT t eff a)
  -> (N.HttpException -> WebDriverTT t eff a)
  -> (IOException -> WebDriverTT t eff a)
  -> (Http.JsonError -> WebDriverTT t eff a)
  -> WebDriverTT t eff a
catchAnyError :: WebDriverTT t eff a
-> (WDError -> WebDriverTT t eff a)
-> (HttpException -> WebDriverTT t eff a)
-> (IOException -> WebDriverTT t eff a)
-> (JsonError -> WebDriverTT t eff a)
-> WebDriverTT t eff a
catchAnyError WebDriverTT t eff a
x WDError -> WebDriverTT t eff a
hE HttpException -> WebDriverTT t eff a
hH IOException -> WebDriverTT t eff a
hI JsonError -> WebDriverTT t eff a
hJ = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (WDError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (HttpException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (IOException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (JsonError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpTT e r w s p t eff a
-> (e -> HttpTT e r w s p t eff a)
-> (HttpException -> HttpTT e r w s p t eff a)
-> (IOException -> HttpTT e r w s p t eff a)
-> (JsonError -> HttpTT e r w s p t eff a)
-> HttpTT e r w s p t eff a
Http.catchAnyError (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT WebDriverTT t eff a
x)
  (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (WDError -> WebDriverTT t eff a)
-> WDError
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDError -> WebDriverTT t eff a
hE) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (HttpException -> WebDriverTT t eff a)
-> HttpException
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> WebDriverTT t eff a
hH) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (IOException -> WebDriverTT t eff a)
-> IOException
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> WebDriverTT t eff a
hI) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (JsonError -> WebDriverTT t eff a)
-> JsonError
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonError -> WebDriverTT t eff a
hJ)

-- | Rethrows other error types
catchError
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff a
  -> (WDError -> WebDriverTT t eff a)
  -> WebDriverTT t eff a
catchError :: WebDriverTT t eff a
-> (WDError -> WebDriverTT t eff a) -> WebDriverTT t eff a
catchError WebDriverTT t eff a
x WDError -> WebDriverTT t eff a
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (WDError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpTT e r w s p t eff a
-> (e -> HttpTT e r w s p t eff a) -> HttpTT e r w s p t eff a
Http.catchError (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT WebDriverTT t eff a
x) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (WDError -> WebDriverTT t eff a)
-> WDError
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDError -> WebDriverTT t eff a
h)

-- | Rethrows other error types
catchJsonError
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff a
  -> (Http.JsonError -> WebDriverTT t eff a)
  -> WebDriverTT t eff a
catchJsonError :: WebDriverTT t eff a
-> (JsonError -> WebDriverTT t eff a) -> WebDriverTT t eff a
catchJsonError WebDriverTT t eff a
x JsonError -> WebDriverTT t eff a
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (JsonError -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpTT e r w s p t eff a
-> (JsonError -> HttpTT e r w s p t eff a)
-> HttpTT e r w s p t eff a
Http.catchJsonError (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT WebDriverTT t eff a
x) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (JsonError -> WebDriverTT t eff a)
-> JsonError
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JsonError -> WebDriverTT t eff a
h)

-- | Rethrows other error types
catchHttpException
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff a
  -> (N.HttpException -> WebDriverTT t eff a)
  -> WebDriverTT t eff a
catchHttpException :: WebDriverTT t eff a
-> (HttpException -> WebDriverTT t eff a) -> WebDriverTT t eff a
catchHttpException WebDriverTT t eff a
x HttpException -> WebDriverTT t eff a
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (HttpException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpTT e r w s p t eff a
-> (HttpException -> HttpTT e r w s p t eff a)
-> HttpTT e r w s p t eff a
Http.catchHttpException (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT WebDriverTT t eff a
x) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (HttpException -> WebDriverTT t eff a)
-> HttpException
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HttpException -> WebDriverTT t eff a
h)

-- | Rethrows other error types
catchIOException
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff a
  -> (IOException -> WebDriverTT t eff a)
  -> WebDriverTT t eff a
catchIOException :: WebDriverTT t eff a
-> (IOException -> WebDriverTT t eff a) -> WebDriverTT t eff a
catchIOException WebDriverTT t eff a
x IOException -> WebDriverTT t eff a
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> (IOException
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
HttpTT e r w s p t eff a
-> (IOException -> HttpTT e r w s p t eff a)
-> HttpTT e r w s p t eff a
Http.catchIOException (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT WebDriverTT t eff a
x) (WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
WebDriverTT t eff a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
unWDT (WebDriverTT t eff a
 -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (IOException -> WebDriverTT t eff a)
-> IOException
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IOException -> WebDriverTT t eff a
h)

-- | May throw a `JsonError`.
parseJson
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => ByteString -> WebDriverTT t eff Value
parseJson :: ByteString -> WebDriverTT t eff Value
parseJson = HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
-> WebDriverTT t eff Value
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
 -> WebDriverTT t eff Value)
-> (ByteString
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff Value)
-> ByteString
-> WebDriverTT t eff Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
ByteString -> HttpTT e r w s p t eff Value
Http.parseJson

-- | May throw a `JsonError`.
lookupKeyJson
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -> Value -> WebDriverTT t eff Value
lookupKeyJson :: Text -> Value -> WebDriverTT t eff Value
lookupKeyJson Text
k = HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
-> WebDriverTT t eff Value
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
 -> WebDriverTT t eff Value)
-> (Value -> HttpTT WDError WDEnv WDLog WDState WDAct t eff Value)
-> Value
-> WebDriverTT t eff Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> Value -> HttpTT WDError WDEnv WDLog WDState WDAct t eff Value
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> Value -> HttpTT e r w s p t eff Value
Http.lookupKeyJson Text
k

-- | May throw a `JsonError`.
constructFromJson
  :: (Monad eff, Monad (t eff), MonadTrans t, FromJSON a)
  => Value -> WebDriverTT t eff a
constructFromJson :: Value -> WebDriverTT t eff a
constructFromJson = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (Value -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> Value
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t, FromJSON a) =>
Value -> HttpTT e r w s p t eff a
Http.constructFromJson

-- | Capures `HttpException`s.
httpGet
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> WebDriverTT t eff Http.HttpResponse
httpGet :: Text -> WebDriverTT t eff HttpResponse
httpGet = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (Text
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> Text
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> HttpTT e r w s p t eff HttpResponse
Http.httpGet

-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.
httpSilentGet
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> WebDriverTT t eff Http.HttpResponse
httpSilentGet :: Text -> WebDriverTT t eff HttpResponse
httpSilentGet = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (Text
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> Text
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> HttpTT e r w s p t eff HttpResponse
Http.httpSilentGet

-- | Capures `HttpException`s.
httpPost
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> ByteString -> WebDriverTT t eff Http.HttpResponse
httpPost :: Text -> ByteString -> WebDriverTT t eff HttpResponse
httpPost Text
url = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (ByteString
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> ByteString
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ByteString
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> ByteString -> HttpTT e r w s p t eff HttpResponse
Http.httpPost Text
url

-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.
httpSilentPost
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> ByteString -> WebDriverTT t eff Http.HttpResponse
httpSilentPost :: Text -> ByteString -> WebDriverTT t eff HttpResponse
httpSilentPost Text
url = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (ByteString
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> ByteString
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text
-> ByteString
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> ByteString -> HttpTT e r w s p t eff HttpResponse
Http.httpSilentPost Text
url

-- | Capures `HttpException`s.
httpDelete
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> WebDriverTT t eff Http.HttpResponse
httpDelete :: Text -> WebDriverTT t eff HttpResponse
httpDelete = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (Text
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> Text
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> HttpTT e r w s p t eff HttpResponse
Http.httpDelete

-- | Does not write request or response info to the log, except to note that a request occurred. Capures `HttpException`s.
httpSilentDelete
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Http.Url -> WebDriverTT t eff Http.HttpResponse
httpSilentDelete :: Text -> WebDriverTT t eff HttpResponse
httpSilentDelete = HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
-> WebDriverTT t eff HttpResponse
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
 -> WebDriverTT t eff HttpResponse)
-> (Text
    -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse)
-> Text
-> WebDriverTT t eff HttpResponse
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff HttpResponse
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> HttpTT e r w s p t eff HttpResponse
Http.httpSilentDelete

-- | Capures `IOException`s.
hPutStrLn
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Handle -> Text -> WebDriverTT t eff ()
hPutStrLn :: Handle -> Text -> WebDriverTT t eff ()
hPutStrLn Handle
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> Text
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handle -> Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Handle -> Text -> HttpTT e r w s p t eff ()
Http.hPutStrLn Handle
h

-- | Capures `IOException`s.
hPutStrLnBlocking
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => MVar () -> Handle -> Text -> WebDriverTT t eff ()
hPutStrLnBlocking :: MVar () -> Handle -> Text -> WebDriverTT t eff ()
hPutStrLnBlocking MVar ()
lock Handle
h = HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
-> WebDriverTT t eff ()
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
 -> WebDriverTT t eff ())
-> (Text -> HttpTT WDError WDEnv WDLog WDState WDAct t eff ())
-> Text
-> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MVar ()
-> Handle
-> Text
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) e r w s
       (p :: * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
MVar () -> Handle -> Text -> HttpTT e r w s p t eff ()
Http.hPutStrLnBlocking MVar ()
lock Handle
h

promptWDAct
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WDAct a -> WebDriverTT t eff a
promptWDAct :: WDAct a -> WebDriverTT t eff a
promptWDAct = HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
forall (t :: (* -> *) -> * -> *) (eff :: * -> *) a.
HttpTT WDError WDEnv WDLog WDState WDAct t eff a
-> WebDriverTT t eff a
WDT (HttpTT WDError WDEnv WDLog WDState WDAct t eff a
 -> WebDriverTT t eff a)
-> (WDAct a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> WDAct a
-> WebDriverTT t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. P WDAct a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) (p :: * -> *) a e
       r w s.
(Monad eff, Monad (t eff), MonadTrans t) =>
P p a -> HttpTT e r w s p t eff a
Http.prompt (P WDAct a -> HttpTT WDError WDEnv WDLog WDState WDAct t eff a)
-> (WDAct a -> P WDAct a)
-> WDAct a
-> HttpTT WDError WDEnv WDLog WDState WDAct t eff a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WDAct a -> P WDAct a
forall (p :: * -> *) a. p a -> P p a
Http.P



instance
  (Monad eff, Monad (t eff), MonadTrans t)
    => Assert (WebDriverTT t eff) where
  assert :: Assertion -> WebDriverTT t eff ()
assert = WDLog -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WDLog -> WebDriverTT t eff ()
logNotice (WDLog -> WebDriverTT t eff ())
-> (Assertion -> WDLog) -> Assertion -> WebDriverTT t eff ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Assertion -> WDLog
LogAssertion





-- | Filter the assertions from a WebDriver log.
getAssertions :: [WDLog] -> [Assertion]
getAssertions :: [WDLog] -> [Assertion]
getAssertions [WDLog]
xs = [WDLog] -> [Assertion]
get [WDLog]
xs
  where
    get :: [WDLog] -> [Assertion]
get [] = []
    get (WDLog
w:[WDLog]
ws) = case WDLog
w of
      LogAssertion Assertion
a -> Assertion
a Assertion -> [Assertion] -> [Assertion]
forall a. a -> [a] -> [a]
: [WDLog] -> [Assertion]
get [WDLog]
ws
      WDLog
_ -> [WDLog] -> [Assertion]
get [WDLog]
ws



-- | Errors specific to WebDriver sessions.
data WDError
  = NoSession

  -- | See <https://w3c.github.io/webdriver/webdriver-spec.html#handling-errors>
  | ResponseError ResponseErrorCode Text Text (Maybe Value) Status

  | UnableToConnect
  | RemoteEndTimeout
  | UnhandledHttpException N.HttpException
  | ImageDecodeError Text
  | UnexpectedValue Text
  | UnexpectedResult Outcome Text
  | BreakpointHaltError
  deriving Int -> WDError -> ShowS
[WDError] -> ShowS
WDError -> String
(Int -> WDError -> ShowS)
-> (WDError -> String) -> ([WDError] -> ShowS) -> Show WDError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WDError] -> ShowS
$cshowList :: [WDError] -> ShowS
show :: WDError -> String
$cshow :: WDError -> String
showsPrec :: Int -> WDError -> ShowS
$cshowsPrec :: Int -> WDError -> ShowS
Show

-- | Read-only environment variables specific to WebDriver.
data WDEnv = WDEnv
  { -- | Hostname of the remote WebDriver server
    WDEnv -> Text
_remoteHostname :: Text

    -- | Port of the remote WebDriver server
  , WDEnv -> Int
_remotePort :: Int

    -- | Extra path for the remote WebDriver server
  , WDEnv -> Text
_remotePath :: Text

    -- | Path where secret data is stored
  , WDEnv -> String
_dataPath :: FilePath

    -- | Flag for the format of HTTP responses from the remote end. Needed because not all remote ends are spec-compliant.
  , WDEnv -> ResponseFormat
_responseFormat :: ResponseFormat

    -- | Version of the WebDriver specification.
  , WDEnv -> ApiVersion
_apiVersion :: ApiVersion

  , WDEnv -> Handle
_stdin :: Handle
  , WDEnv -> Handle
_stdout :: Handle
  }

-- | Version of the WebDriver specification.
data ApiVersion
  = CR_2018_03_04 -- ^ Candidate Recommendation, March 4, 2018
  deriving (ApiVersion -> ApiVersion -> Bool
(ApiVersion -> ApiVersion -> Bool)
-> (ApiVersion -> ApiVersion -> Bool) -> Eq ApiVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ApiVersion -> ApiVersion -> Bool
$c/= :: ApiVersion -> ApiVersion -> Bool
== :: ApiVersion -> ApiVersion -> Bool
$c== :: ApiVersion -> ApiVersion -> Bool
Eq, Int -> ApiVersion -> ShowS
[ApiVersion] -> ShowS
ApiVersion -> String
(Int -> ApiVersion -> ShowS)
-> (ApiVersion -> String)
-> ([ApiVersion] -> ShowS)
-> Show ApiVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ApiVersion] -> ShowS
$cshowList :: [ApiVersion] -> ShowS
show :: ApiVersion -> String
$cshow :: ApiVersion -> String
showsPrec :: Int -> ApiVersion -> ShowS
$cshowsPrec :: Int -> ApiVersion -> ShowS
Show)

-- | Format flag for HTTP responses from the remote end. Chromedriver, for instance, is not spec-compliant. :)
data ResponseFormat
  = SpecFormat -- ^ Responses as described in the spec.
  | ChromeFormat -- ^ Responses as emitted by chromedriver.
  deriving (ResponseFormat -> ResponseFormat -> Bool
(ResponseFormat -> ResponseFormat -> Bool)
-> (ResponseFormat -> ResponseFormat -> Bool) -> Eq ResponseFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseFormat -> ResponseFormat -> Bool
$c/= :: ResponseFormat -> ResponseFormat -> Bool
== :: ResponseFormat -> ResponseFormat -> Bool
$c== :: ResponseFormat -> ResponseFormat -> Bool
Eq, Int -> ResponseFormat -> ShowS
[ResponseFormat] -> ShowS
ResponseFormat -> String
(Int -> ResponseFormat -> ShowS)
-> (ResponseFormat -> String)
-> ([ResponseFormat] -> ShowS)
-> Show ResponseFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ResponseFormat] -> ShowS
$cshowList :: [ResponseFormat] -> ShowS
show :: ResponseFormat -> String
$cshow :: ResponseFormat -> String
showsPrec :: Int -> ResponseFormat -> ShowS
$cshowsPrec :: Int -> ResponseFormat -> ShowS
Show)

data BreakpointSetting
  = BreakpointsOn
  | BreakpointsOff
  deriving (BreakpointSetting -> BreakpointSetting -> Bool
(BreakpointSetting -> BreakpointSetting -> Bool)
-> (BreakpointSetting -> BreakpointSetting -> Bool)
-> Eq BreakpointSetting
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreakpointSetting -> BreakpointSetting -> Bool
$c/= :: BreakpointSetting -> BreakpointSetting -> Bool
== :: BreakpointSetting -> BreakpointSetting -> Bool
$c== :: BreakpointSetting -> BreakpointSetting -> Bool
Eq, Int -> BreakpointSetting -> ShowS
[BreakpointSetting] -> ShowS
BreakpointSetting -> String
(Int -> BreakpointSetting -> ShowS)
-> (BreakpointSetting -> String)
-> ([BreakpointSetting] -> ShowS)
-> Show BreakpointSetting
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreakpointSetting] -> ShowS
$cshowList :: [BreakpointSetting] -> ShowS
show :: BreakpointSetting -> String
$cshow :: BreakpointSetting -> String
showsPrec :: Int -> BreakpointSetting -> ShowS
$cshowsPrec :: Int -> BreakpointSetting -> ShowS
Show)

-- | Includes a @Maybe Text@ representing the current session ID, if one has been opened.
data WDState = WDState
  { WDState -> Maybe Text
_sessionId :: Maybe Text
  , WDState -> BreakpointSetting
_breakpoints :: BreakpointSetting
  } deriving Int -> WDState -> ShowS
[WDState] -> ShowS
WDState -> String
(Int -> WDState -> ShowS)
-> (WDState -> String) -> ([WDState] -> ShowS) -> Show WDState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WDState] -> ShowS
$cshowList :: [WDState] -> ShowS
show :: WDState -> String
$cshow :: WDState -> String
showsPrec :: Int -> WDState -> ShowS
$cshowsPrec :: Int -> WDState -> ShowS
Show

breakpointsOn
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff ()
breakpointsOn :: WebDriverTT t eff ()
breakpointsOn = (S WDState -> S WDState) -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
(S WDState -> S WDState) -> WebDriverTT t eff ()
modifyState ((S WDState -> S WDState) -> WebDriverTT t eff ())
-> (S WDState -> S WDState) -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ \S WDState
st -> S WDState
st
  { _userState :: WDState
Http._userState = (S WDState -> WDState
forall s. S s -> s
Http._userState S WDState
st)
    { _breakpoints :: BreakpointSetting
_breakpoints = BreakpointSetting
BreakpointsOn
    }
  }

breakpointsOff
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff ()
breakpointsOff :: WebDriverTT t eff ()
breakpointsOff = (S WDState -> S WDState) -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
(S WDState -> S WDState) -> WebDriverTT t eff ()
modifyState ((S WDState -> S WDState) -> WebDriverTT t eff ())
-> (S WDState -> S WDState) -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ \S WDState
st -> S WDState
st
  { _userState :: WDState
Http._userState = (S WDState -> WDState
forall s. S s -> s
Http._userState S WDState
st)
    { _breakpoints :: BreakpointSetting
_breakpoints = BreakpointSetting
BreakpointsOff
    }
  }

-- | WebDriver specific log entries.
data WDLog
  = LogAssertion Assertion
  | LogSession SessionVerb
  | LogUnexpectedResult Outcome Text
  | LogBreakpoint Text
  deriving Int -> WDLog -> ShowS
[WDLog] -> ShowS
WDLog -> String
(Int -> WDLog -> ShowS)
-> (WDLog -> String) -> ([WDLog] -> ShowS) -> Show WDLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WDLog] -> ShowS
$cshowList :: [WDLog] -> ShowS
show :: WDLog -> String
$cshow :: WDLog -> String
showsPrec :: Int -> WDLog -> ShowS
$cshowsPrec :: Int -> WDLog -> ShowS
Show

-- | Pretty printer for log entries.
printWDLog :: Bool -> WDLog -> Text
printWDLog :: Bool -> WDLog -> Text
printWDLog Bool
_ WDLog
w = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ WDLog -> String
forall a. Show a => a -> String
show WDLog
w

-- | Type representing an abstract outcome. Do with it what you will.
data Outcome = IsSuccess | IsFailure
  deriving (Outcome -> Outcome -> Bool
(Outcome -> Outcome -> Bool)
-> (Outcome -> Outcome -> Bool) -> Eq Outcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Outcome -> Outcome -> Bool
$c/= :: Outcome -> Outcome -> Bool
== :: Outcome -> Outcome -> Bool
$c== :: Outcome -> Outcome -> Bool
Eq, Int -> Outcome -> ShowS
[Outcome] -> ShowS
Outcome -> String
(Int -> Outcome -> ShowS)
-> (Outcome -> String) -> ([Outcome] -> ShowS) -> Show Outcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Outcome] -> ShowS
$cshowList :: [Outcome] -> ShowS
show :: Outcome -> String
$cshow :: Outcome -> String
showsPrec :: Int -> Outcome -> ShowS
$cshowsPrec :: Int -> Outcome -> ShowS
Show)

-- | Representation of the actions we can perform on a `Session` (in the @wreq@ sense).
data SessionVerb
  = Close | Open
  deriving (SessionVerb -> SessionVerb -> Bool
(SessionVerb -> SessionVerb -> Bool)
-> (SessionVerb -> SessionVerb -> Bool) -> Eq SessionVerb
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SessionVerb -> SessionVerb -> Bool
$c/= :: SessionVerb -> SessionVerb -> Bool
== :: SessionVerb -> SessionVerb -> Bool
$c== :: SessionVerb -> SessionVerb -> Bool
Eq, Int -> SessionVerb -> ShowS
[SessionVerb] -> ShowS
SessionVerb -> String
(Int -> SessionVerb -> ShowS)
-> (SessionVerb -> String)
-> ([SessionVerb] -> ShowS)
-> Show SessionVerb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SessionVerb] -> ShowS
$cshowList :: [SessionVerb] -> ShowS
show :: SessionVerb -> String
$cshow :: SessionVerb -> String
showsPrec :: Int -> SessionVerb -> ShowS
$cshowsPrec :: Int -> SessionVerb -> ShowS
Show)

-- | WebDriver specific effects
data WDAct a where
  ReadFilePath :: FilePath -> WDAct (Either IOException ByteString)
  WriteFilePath :: FilePath -> ByteString -> WDAct (Either IOException ())
  FileExists :: FilePath -> WDAct (Either IOException Bool)

  HGetLine :: Handle -> WDAct (Either IOException Text)
  HGetLineNoEcho :: Handle -> WDAct (Either IOException Text)



-- | For validating responses. Throws an `UnexpectedValue` error if the two arguments are not equal according to their `Eq` instance.
expect
  :: (Monad eff, Monad (t eff), MonadTrans t, Eq a, Show a)
  => a
  -> a
  -> WebDriverTT t eff a
expect :: a -> a -> WebDriverTT t eff a
expect a
x a
y = if a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y
  then a -> WebDriverTT t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return a
y
  else WDError -> WebDriverTT t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDError -> WebDriverTT t eff a
throwError (WDError -> WebDriverTT t eff a) -> WDError -> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ Text -> WDError
UnexpectedValue (Text -> WDError) -> Text -> WDError
forall a b. (a -> b) -> a -> b
$
    Text
"expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
x) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
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)
  -> Text -- ^ Human readable error label
  -> a
  -> WebDriverTT t eff a
expectIs :: (a -> Bool) -> Text -> a -> WebDriverTT t eff a
expectIs a -> Bool
p Text
label a
x = if a -> Bool
p a
x
  then a -> WebDriverTT t eff a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
  else WDError -> WebDriverTT t eff a
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDError -> WebDriverTT t eff a
throwError (WDError -> WebDriverTT t eff a) -> WDError -> WebDriverTT t eff a
forall a b. (a -> b) -> a -> b
$ Text -> WDError
UnexpectedValue (Text -> WDError) -> Text -> WDError
forall a b. (a -> b) -> a -> b
$
    Text
"expected " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
label Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
x)

-- | Promote semantic HTTP exceptions to typed errors.
promoteHttpResponseError :: N.HttpException -> Maybe WDError
promoteHttpResponseError :: HttpException -> Maybe WDError
promoteHttpResponseError HttpException
e = case HttpException
e of
  N.HttpExceptionRequest Request
_ (N.StatusCodeException Response ()
s ByteString
r) -> do
    Value
err <- ByteString
r ByteString -> Getting (First Value) ByteString Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"value" Getting (First Value) ByteString Value
-> ((Value -> Const (First Value) Value)
    -> Value -> Const (First Value) Value)
-> Getting (First Value) ByteString Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"error" ((Value -> Const (First Value) Value)
 -> Value -> Const (First Value) Value)
-> ((Value -> Const (First Value) Value)
    -> Value -> Const (First Value) Value)
-> (Value -> Const (First Value) Value)
-> Value
-> Const (First Value) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Value) Value)
-> Value -> Const (First Value) Value
forall t. AsValue t => Prism' t Value
_Value
    ResponseErrorCode
code <- case Value -> Result ResponseErrorCode
forall a. FromJSON a => Value -> Result a
fromJSON Value
err of
      Success ResponseErrorCode
m -> ResponseErrorCode -> Maybe ResponseErrorCode
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseErrorCode
m
      Result ResponseErrorCode
_ -> Maybe ResponseErrorCode
forall a. Maybe a
Nothing
    Text
msg <- ByteString
r ByteString -> Getting (First Text) ByteString Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"value" ((Value -> Const (First Text) Value)
 -> ByteString -> Const (First Text) ByteString)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) ByteString Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"message" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
_String
    Text
str <- ByteString
r ByteString -> Getting (First Text) ByteString Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"value" ((Value -> Const (First Text) Value)
 -> ByteString -> Const (First Text) ByteString)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> Getting (First Text) ByteString Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"stacktrace" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> ((Text -> Const (First Text) Text)
    -> Value -> Const (First Text) Value)
-> (Text -> Const (First Text) Text)
-> Value
-> Const (First Text) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> Value -> Const (First Text) Value
forall t. AsValue t => Prism' t Text
_String
    let obj :: Maybe Value
obj = ByteString
r ByteString -> Getting (First Value) ByteString Value -> Maybe Value
forall s a. s -> Getting (First a) s a -> Maybe a
^? Key -> Traversal' ByteString Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"value" Getting (First Value) ByteString Value
-> ((Value -> Const (First Value) Value)
    -> Value -> Const (First Value) Value)
-> Getting (First Value) ByteString Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
key Key
"data" ((Value -> Const (First Value) Value)
 -> Value -> Const (First Value) Value)
-> ((Value -> Const (First Value) Value)
    -> Value -> Const (First Value) Value)
-> (Value -> Const (First Value) Value)
-> Value
-> Const (First Value) Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (First Value) Value)
-> Value -> Const (First Value) Value
forall t. AsValue t => Prism' t Value
_Value
    Status
status <- Response ()
s Response ()
-> Getting (First Status) (Response ()) Status -> Maybe Status
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First Status) (Response ()) Status
forall body. Lens' (Response body) Status
responseStatus
    WDError -> Maybe WDError
forall (m :: * -> *) a. Monad m => a -> m a
return (WDError -> Maybe WDError) -> WDError -> Maybe WDError
forall a b. (a -> b) -> a -> b
$ ResponseErrorCode
-> Text -> Text -> Maybe Value -> Status -> WDError
ResponseError ResponseErrorCode
code Text
msg Text
str Maybe Value
obj Status
status

  N.HttpExceptionRequest Request
_ (N.ConnectionFailure SomeException
_) -> WDError -> Maybe WDError
forall a. a -> Maybe a
Just WDError
UnableToConnect

  N.HttpExceptionRequest Request
_ HttpExceptionContent
N.ConnectionTimeout -> WDError -> Maybe WDError
forall a. a -> Maybe a
Just WDError
RemoteEndTimeout

  HttpException
_ -> WDError -> Maybe WDError
forall a. a -> Maybe a
Just (WDError -> Maybe WDError) -> WDError -> Maybe WDError
forall a b. (a -> b) -> a -> b
$ HttpException -> WDError
UnhandledHttpException HttpException
e

-- | For pretty printing.
printWDError :: Bool -> WDError -> Text
printWDError :: Bool -> WDError -> Text
printWDError Bool
_ WDError
e = case WDError
e of
  WDError
NoSession -> Text
"No session in progress"
  ResponseError ResponseErrorCode
_ Text
msg Text
trace Maybe Value
obj Status
status ->
    let
      code :: Int
code = Status
status Status -> Getting Int Status Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Status Int
Lens' Status Int
statusCode
      smsg :: ByteString
smsg = Status
status Status -> Getting ByteString Status ByteString -> ByteString
forall s a. s -> Getting a s a -> a
^. Getting ByteString Status ByteString
Lens' Status ByteString
statusMessage
    in
      ((Text
"Response: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
code) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 ByteString
smsg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$
      ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$ [Pair] -> Value
object
        [ Key
"error" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Int -> Value
forall a. ToJSON a => a -> Value
toJSON Int
code
        , Key
"message" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
msg
        , Key
"stacktrace" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
forall a. ToJSON a => a -> Value
toJSON Text
trace
        , Key
"data" Key -> Maybe Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Value -> Value
forall a. ToJSON a => a -> Value
toJSON (Value -> Value) -> Maybe Value -> Maybe Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Value
obj)
        ]
  WDError
UnableToConnect -> Text
"Unable to connect to WebDriver server"
  WDError
RemoteEndTimeout -> Text
"Remote End Timeout"
  UnhandledHttpException HttpException
ex -> Text
"Unhandled HTTP Exception: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (HttpException -> String
forall a. Show a => a -> String
show HttpException
ex)
  ImageDecodeError Text
msg -> Text
"Image decode: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
  UnexpectedValue Text
msg -> Text
"Unexpected value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
  UnexpectedResult Outcome
r Text
msg -> case Outcome
r of
    Outcome
IsSuccess -> Text
"Unexpected success: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
    Outcome
IsFailure -> Text
"Unexpected failure: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
msg
  WDError
BreakpointHaltError -> Text
"Breakpoint Halt"

putStrLn
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -> WebDriverTT t eff ()
putStrLn :: Text -> WebDriverTT t eff ()
putStrLn Text
str = do
  Handle
outH <- (R WDError WDLog WDEnv -> Handle) -> WebDriverTT t eff Handle
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> Handle
_stdout (WDEnv -> Handle)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
Http._env)
  Handle -> Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Handle -> Text -> WebDriverTT t eff ()
hPutStrLn Handle
outH Text
str

getStrLn
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => WebDriverTT t eff Text
getStrLn :: WebDriverTT t eff Text
getStrLn = do
  Handle
inH <- (R WDError WDLog WDEnv -> Handle) -> WebDriverTT t eff Handle
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> Handle
_stdin (WDEnv -> Handle)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
Http._env)
  Either IOException Text
result <- WDAct (Either IOException Text)
-> WebDriverTT t eff (Either IOException Text)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDAct a -> WebDriverTT t eff a
promptWDAct (WDAct (Either IOException Text)
 -> WebDriverTT t eff (Either IOException Text))
-> WDAct (Either IOException Text)
-> WebDriverTT t eff (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ Handle -> WDAct (Either IOException Text)
HGetLine Handle
inH
  case Either IOException Text
result of
    Right Text
string -> Text -> WebDriverTT t eff Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
string
    Left IOException
e -> IOException -> WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> WebDriverTT t eff a
throwIOException IOException
e

-- | Prompt for input on `stdin`.
promptForString
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -- ^ Prompt text
  -> WebDriverTT t eff Text
promptForString :: Text -> WebDriverTT t eff Text
promptForString Text
prompt =
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
prompt WebDriverTT t eff ()
-> WebDriverTT t eff Text -> WebDriverTT t eff Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverTT t eff Text
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)
  => Text -- ^ Prompt text
  -> WebDriverTT t eff Text
promptForSecret :: Text -> WebDriverTT t eff Text
promptForSecret Text
prompt = do
  Handle
outH <- (R WDError WDLog WDEnv -> Handle) -> WebDriverTT t eff Handle
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> Handle
_stdout (WDEnv -> Handle)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
Http._env)
  Handle
inH <- (R WDError WDLog WDEnv -> Handle) -> WebDriverTT t eff Handle
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv (WDEnv -> Handle
_stdin (WDEnv -> Handle)
-> (R WDError WDLog WDEnv -> WDEnv)
-> R WDError WDLog WDEnv
-> Handle
forall b c a. (b -> c) -> (a -> b) -> a -> c
. R WDError WDLog WDEnv -> WDEnv
forall e w r. R e w r -> r
Http._env)
  Handle -> Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Handle -> Text -> WebDriverTT t eff ()
hPutStrLn Handle
outH Text
prompt
  Either IOException Text
result <- WDAct (Either IOException Text)
-> WebDriverTT t eff (Either IOException Text)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDAct a -> WebDriverTT t eff a
promptWDAct (WDAct (Either IOException Text)
 -> WebDriverTT t eff (Either IOException Text))
-> WDAct (Either IOException Text)
-> WebDriverTT t eff (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ Handle -> WDAct (Either IOException Text)
HGetLineNoEcho Handle
inH
  case Either IOException Text
result of
    Right Text
string -> Text -> WebDriverTT t eff Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
string
    Left IOException
e -> IOException -> WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> WebDriverTT t eff a
throwIOException IOException
e

-- | Captures `IOException`s
readFilePath
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath
  -> WebDriverTT t eff ByteString
readFilePath :: String -> WebDriverTT t eff ByteString
readFilePath String
path = do
  Either IOException ByteString
result <- WDAct (Either IOException ByteString)
-> WebDriverTT t eff (Either IOException ByteString)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDAct a -> WebDriverTT t eff a
promptWDAct (WDAct (Either IOException ByteString)
 -> WebDriverTT t eff (Either IOException ByteString))
-> WDAct (Either IOException ByteString)
-> WebDriverTT t eff (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ String -> WDAct (Either IOException ByteString)
ReadFilePath String
path
  case Either IOException ByteString
result of
    Right ByteString
bytes -> ByteString -> WebDriverTT t eff ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bytes
    Left IOException
e -> IOException -> WebDriverTT t eff ByteString
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> WebDriverTT t eff a
throwIOException IOException
e

-- | Captures `IOException`s
writeFilePath
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath
  -> ByteString
  -> WebDriverTT t eff ()
writeFilePath :: String -> ByteString -> WebDriverTT t eff ()
writeFilePath String
path ByteString
bytes = do
  Either IOException ()
result <- WDAct (Either IOException ())
-> WebDriverTT t eff (Either IOException ())
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDAct a -> WebDriverTT t eff a
promptWDAct (WDAct (Either IOException ())
 -> WebDriverTT t eff (Either IOException ()))
-> WDAct (Either IOException ())
-> WebDriverTT t eff (Either IOException ())
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> WDAct (Either IOException ())
WriteFilePath String
path ByteString
bytes
  case Either IOException ()
result of
    Right () -> () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left IOException
e -> IOException -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> WebDriverTT t eff a
throwIOException IOException
e

-- | Captures `IOException`s
fileExists
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => FilePath
  -> WebDriverTT t eff Bool
fileExists :: String -> WebDriverTT t eff Bool
fileExists String
path = do
  Either IOException Bool
result <- WDAct (Either IOException Bool)
-> WebDriverTT t eff (Either IOException Bool)
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDAct a -> WebDriverTT t eff a
promptWDAct (WDAct (Either IOException Bool)
 -> WebDriverTT t eff (Either IOException Bool))
-> WDAct (Either IOException Bool)
-> WebDriverTT t eff (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ String -> WDAct (Either IOException Bool)
FileExists String
path
  case Either IOException Bool
result of
    Right Bool
p -> Bool -> WebDriverTT t eff Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
p
    Left IOException
e -> IOException -> WebDriverTT t eff Bool
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
IOException -> WebDriverTT t eff a
throwIOException IOException
e



data BreakpointAction
  = BreakpointContinue
  | BreakpointHalt
  | BreakpointDump -- ^ Show the current state and environment
  | BreakpointSilence -- ^ Turn breakpoints off and continue
  | BreakpointAct -- ^ Client-supplied action
  deriving (BreakpointAction -> BreakpointAction -> Bool
(BreakpointAction -> BreakpointAction -> Bool)
-> (BreakpointAction -> BreakpointAction -> Bool)
-> Eq BreakpointAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BreakpointAction -> BreakpointAction -> Bool
$c/= :: BreakpointAction -> BreakpointAction -> Bool
== :: BreakpointAction -> BreakpointAction -> Bool
$c== :: BreakpointAction -> BreakpointAction -> Bool
Eq, Int -> BreakpointAction -> ShowS
[BreakpointAction] -> ShowS
BreakpointAction -> String
(Int -> BreakpointAction -> ShowS)
-> (BreakpointAction -> String)
-> ([BreakpointAction] -> ShowS)
-> Show BreakpointAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BreakpointAction] -> ShowS
$cshowList :: [BreakpointAction] -> ShowS
show :: BreakpointAction -> String
$cshow :: BreakpointAction -> String
showsPrec :: Int -> BreakpointAction -> ShowS
$cshowsPrec :: Int -> BreakpointAction -> ShowS
Show)

parseBreakpointAction :: Text -> Maybe BreakpointAction
parseBreakpointAction :: Text -> Maybe BreakpointAction
parseBreakpointAction Text
str = case Text
str of
  Text
"c" -> BreakpointAction -> Maybe BreakpointAction
forall a. a -> Maybe a
Just BreakpointAction
BreakpointContinue
  Text
"h" -> BreakpointAction -> Maybe BreakpointAction
forall a. a -> Maybe a
Just BreakpointAction
BreakpointHalt
  Text
"d" -> BreakpointAction -> Maybe BreakpointAction
forall a. a -> Maybe a
Just BreakpointAction
BreakpointDump
  Text
"s" -> BreakpointAction -> Maybe BreakpointAction
forall a. a -> Maybe a
Just BreakpointAction
BreakpointSilence
  Text
"a" -> BreakpointAction -> Maybe BreakpointAction
forall a. a -> Maybe a
Just BreakpointAction
BreakpointAct
  Text
_ -> Maybe BreakpointAction
forall a. Maybe a
Nothing

breakpointMessage
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text -> Maybe Text -> WebDriverTT t eff ()
breakpointMessage :: Text -> Maybe Text -> WebDriverTT t eff ()
breakpointMessage Text
msg Maybe Text
custom = do
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"=== BREAKPOINT ==="
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
msg
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"c : continue"
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"h : halt"
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"d : dump webdriver state"
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"s : turn breakpoints off and continue"
  case Maybe Text
custom of
    Just Text
act -> Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn (Text -> WebDriverTT t eff ()) -> Text -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ Text
"a : " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
act
    Maybe Text
Nothing -> () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"=================="

breakpointWith
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text
  -> Maybe (Text, WebDriverTT t eff ())
  -> WebDriverTT t eff ()
breakpointWith :: Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
breakpointWith Text
msg Maybe (Text, WebDriverTT t eff ())
act = do
  BreakpointSetting
bp <- (S WDState -> BreakpointSetting)
-> WebDriverTT t eff BreakpointSetting
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(S WDState -> a) -> WebDriverTT t eff a
fromState (WDState -> BreakpointSetting
_breakpoints (WDState -> BreakpointSetting)
-> (S WDState -> WDState) -> S WDState -> BreakpointSetting
forall b c a. (b -> c) -> (a -> b) -> a -> c
. S WDState -> WDState
forall s. S s -> s
Http._userState)
  case BreakpointSetting
bp of
    BreakpointSetting
BreakpointsOff -> () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    BreakpointSetting
BreakpointsOn -> do
      WDLog -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WDLog -> WebDriverTT t eff ()
logNotice (WDLog -> WebDriverTT t eff ()) -> WDLog -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ Text -> WDLog
LogBreakpoint Text
msg
      let
        (Maybe Text
actionDescription, WebDriverTT t eff ()
action) = case Maybe (Text, WebDriverTT t eff ())
act of
          Maybe (Text, WebDriverTT t eff ())
Nothing -> (Maybe Text
forall a. Maybe a
Nothing, () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
          Just (Text
title, WebDriverTT t eff ()
action') -> (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
title, WebDriverTT t eff ()
action')
      Text -> Maybe Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> Maybe Text -> WebDriverTT t eff ()
breakpointMessage Text
msg Maybe Text
actionDescription
      Text
command <- WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverTT t eff Text
getStrLn
      case Text -> Maybe BreakpointAction
parseBreakpointAction Text
command of
        Just BreakpointAction
BreakpointContinue -> () -> WebDriverTT t eff ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just BreakpointAction
BreakpointHalt -> WDError -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
WDError -> WebDriverTT t eff a
throwError WDError
BreakpointHaltError
        Just BreakpointAction
BreakpointDump -> do
          Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"=== DUMP ========="
          (S WDState -> Text) -> WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(S WDState -> a) -> WebDriverTT t eff a
fromState S WDState -> Text
dumpState WebDriverTT t eff Text
-> (Text -> WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn
          (R WDError WDLog WDEnv -> Text) -> WebDriverTT t eff Text
forall (eff :: * -> *) (t :: (* -> *) -> * -> *) a.
(Monad eff, Monad (t eff), MonadTrans t) =>
(R WDError WDLog WDEnv -> a) -> WebDriverTT t eff a
fromEnv R WDError WDLog WDEnv -> Text
dumpEnv WebDriverTT t eff Text
-> (Text -> WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn
          Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn Text
"=================="
          Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
breakpointWith Text
msg Maybe (Text, WebDriverTT t eff ())
act
        Just BreakpointAction
BreakpointSilence -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
WebDriverTT t eff ()
breakpointsOff
        Just BreakpointAction
BreakpointAct -> WebDriverTT t eff ()
action
        Maybe BreakpointAction
Nothing -> do
          Text -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> WebDriverTT t eff ()
putStrLn (Text -> WebDriverTT t eff ()) -> Text -> WebDriverTT t eff ()
forall a b. (a -> b) -> a -> b
$ Text
"Unrecognized breakpoint option '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
command Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
          Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
breakpointWith Text
msg Maybe (Text, WebDriverTT t eff ())
act

breakpoint
  :: (Monad eff, Monad (t eff), MonadTrans t)
  => Text
  -> WebDriverTT t eff ()
breakpoint :: Text -> WebDriverTT t eff ()
breakpoint Text
msg = Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
forall (eff :: * -> *) (t :: (* -> *) -> * -> *).
(Monad eff, Monad (t eff), MonadTrans t) =>
Text -> Maybe (Text, WebDriverTT t eff ()) -> WebDriverTT t eff ()
breakpointWith Text
msg Maybe (Text, WebDriverTT t eff ())
forall a. Maybe a
Nothing

dumpState :: Http.S WDState -> Text
dumpState :: S WDState -> Text
dumpState Http.S{Maybe Session
Options
WDState
_userState :: WDState
_httpSession :: Maybe Session
_httpOptions :: Options
_userState :: forall s. S s -> s
_httpSession :: forall s. S s -> Maybe Session
_httpOptions :: forall s. S s -> Options
..} = Text -> [Text] -> Text
T.intercalate Text
"\n"
  [ Text
"Session ID: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Maybe Text -> String
forall a. Show a => a -> String
show (Maybe Text -> String) -> Maybe Text -> String
forall a b. (a -> b) -> a -> b
$ WDState -> Maybe Text
_sessionId WDState
_userState)
  , String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ BreakpointSetting -> String
forall a. Show a => a -> String
show (WDState -> BreakpointSetting
_breakpoints WDState
_userState)
  ]

dumpEnv :: Http.R WDError WDLog WDEnv -> Text
dumpEnv :: R WDError WDLog WDEnv -> Text
dumpEnv Http.R{Maybe (MVar ())
Text
Handle
LogOptions WDError WDLog
WDEnv
HttpException -> Maybe WDError
LogOptions WDError WDLog -> LogEntry WDError WDLog -> Maybe Text
_env :: WDEnv
_httpErrorInject :: HttpException -> Maybe WDError
_uid :: Text
_logLock :: Maybe (MVar ())
_logHandle :: Handle
_logEntryPrinter :: LogOptions WDError WDLog -> LogEntry WDError WDLog -> Maybe Text
_logOptions :: LogOptions WDError WDLog
_env :: forall e w r. R e w r -> r
_httpErrorInject :: forall e w r. R e w r -> HttpException -> Maybe e
_logOptions :: forall e w r. R e w r -> LogOptions e w
_uid :: forall e w r. R e w r -> Text
_logEntryPrinter :: forall e w r.
R e w r -> LogOptions e w -> LogEntry e w -> Maybe Text
_logLock :: forall e w r. R e w r -> Maybe (MVar ())
_logHandle :: forall e w r. R e w r -> Handle
..} = Text -> [Text] -> Text
T.intercalate Text
"\n"
  [ Text
"Remote Host: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (WDEnv -> Text
_remoteHostname WDEnv
_env)
  , Text
"Remote Port: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ WDEnv -> Int
_remotePort WDEnv
_env)
  , Text
"Remote Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (WDEnv -> Text
_remotePath WDEnv
_env)
  , Text
"Data Path: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (WDEnv -> String
_dataPath WDEnv
_env)
  , Text
"Response Format: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ResponseFormat -> String
forall a. Show a => a -> String
show (ResponseFormat -> String) -> ResponseFormat -> String
forall a b. (a -> b) -> a -> b
$ WDEnv -> ResponseFormat
_responseFormat WDEnv
_env)
  , Text
"API Version: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ApiVersion -> String
forall a. Show a => a -> String
show (ApiVersion -> String) -> ApiVersion -> String
forall a b. (a -> b) -> a -> b
$ WDEnv -> ApiVersion
_apiVersion WDEnv
_env)
  ]



-- | Standard `IO` evaluator for `WDAct`.
evalWDAct :: WDAct a -> IO a
evalWDAct :: WDAct a -> IO a
evalWDAct WDAct a
act = case WDAct a
act of
  ReadFilePath String
path -> IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO ByteString -> IO (Either IOException ByteString))
-> IO ByteString -> IO (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
readFile String
path
  WriteFilePath String
path ByteString
bytes -> IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (IO () -> IO (Either IOException ()))
-> IO () -> IO (Either IOException ())
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
writeFile String
path ByteString
bytes
  FileExists String
path -> IO Bool -> IO (Either IOException Bool)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Bool -> IO (Either IOException Bool))
-> IO Bool -> IO (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesFileExist String
path

  HGetLine Handle
handle -> IO Text -> IO (Either IOException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either IOException Text))
-> IO Text -> IO (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ do
    Handle -> IO Text
T.hGetLine Handle
handle

  HGetLineNoEcho Handle
handle -> IO Text -> IO (Either IOException Text)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO Text -> IO (Either IOException Text))
-> IO Text -> IO (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ do
    Bool
echo <- Handle -> IO Bool
hGetEcho Handle
handle
    Handle -> Bool -> IO ()
hSetEcho Handle
handle Bool
False
    Text
secret <- Handle -> IO Text
T.hGetLine Handle
handle
    Handle -> Bool -> IO ()
hSetEcho Handle
handle Bool
echo
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
secret



-- | Standard `Mock.MockIO` evaluator for `WDAct`.
evalWDActMockIO :: WDAct a -> Mock.MockIO u a
evalWDActMockIO :: WDAct a -> MockIO u a
evalWDActMockIO WDAct a
act = case WDAct a
act of
  ReadFilePath String
path -> do
    Int -> MockIO u ()
forall s. Int -> MockIO s ()
Mock.incrementTimer Int
1
    MockWorld u
world <- MockIO u (MockWorld u)
forall s. MockIO s (MockWorld s)
Mock.getMockWorld
    let result :: Maybe [Text]
result = Either String Handle
-> FileSystem (Either String Handle) -> Maybe [Text]
forall a. Eq a => a -> FileSystem a -> Maybe [Text]
FS.getLines (String -> Either String Handle
forall a b. a -> Either a b
Left String
path) (FileSystem (Either String Handle) -> Maybe [Text])
-> FileSystem (Either String Handle) -> Maybe [Text]
forall a b. (a -> b) -> a -> b
$ MockWorld u -> FileSystem (Either String Handle)
forall s. MockWorld s -> FileSystem (Either String Handle)
Mock._files MockWorld u
world
    case Maybe [Text]
result of
      Maybe [Text]
Nothing -> do
        Either IOException ByteString
-> MockIO u (Either IOException ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException ByteString
 -> MockIO u (Either IOException ByteString))
-> Either IOException ByteString
-> MockIO u (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ IOException -> Either IOException ByteString
forall a b. a -> Either a b
Left (IOException -> Either IOException ByteString)
-> IOException -> Either IOException ByteString
forall a b. (a -> b) -> a -> b
$ IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
doesNotExistErrorType String
"" Maybe Handle
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
path)
      Just [Text]
lns -> Either IOException ByteString
-> MockIO u (Either IOException ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException ByteString
 -> MockIO u (Either IOException ByteString))
-> Either IOException ByteString
-> MockIO u (Either IOException ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either IOException ByteString
forall a b. b -> Either a b
Right (ByteString -> Either IOException ByteString)
-> ByteString -> Either IOException ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
fromStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
T.unlines [Text]
lns

  WriteFilePath String
path ByteString
bytes -> do
    Int -> MockIO u ()
forall s. Int -> MockIO s ()
Mock.incrementTimer Int
1
    (() -> Either IOException ())
-> MockIO u () -> MockIO u (Either IOException ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either IOException ()
forall a b. b -> Either a b
Right (MockIO u () -> MockIO u (Either IOException ()))
-> MockIO u () -> MockIO u (Either IOException ())
forall a b. (a -> b) -> a -> b
$ (MockWorld u -> MockWorld u) -> MockIO u ()
forall s. (MockWorld s -> MockWorld s) -> MockIO s ()
Mock.modifyMockWorld ((MockWorld u -> MockWorld u) -> MockIO u ())
-> (MockWorld u -> MockWorld u) -> MockIO u ()
forall a b. (a -> b) -> a -> b
$ \MockWorld u
w -> MockWorld u
w
      { _files :: FileSystem (Either String Handle)
Mock._files = Either String Handle
-> [Text]
-> FileSystem (Either String Handle)
-> FileSystem (Either String Handle)
forall a. Eq a => a -> [Text] -> FileSystem a -> FileSystem a
FS.writeLines (String -> Either String Handle
forall a b. a -> Either a b
Left String
path) [ByteString -> Text
T.decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict ByteString
bytes] (FileSystem (Either String Handle)
 -> FileSystem (Either String Handle))
-> FileSystem (Either String Handle)
-> FileSystem (Either String Handle)
forall a b. (a -> b) -> a -> b
$ MockWorld u -> FileSystem (Either String Handle)
forall s. MockWorld s -> FileSystem (Either String Handle)
Mock._files MockWorld u
w }

  FileExists String
path -> do
    Int -> MockIO u ()
forall s. Int -> MockIO s ()
Mock.incrementTimer Int
1
    MockWorld u
world <- MockIO u (MockWorld u)
forall s. MockIO s (MockWorld s)
Mock.getMockWorld
    Either IOException Bool -> MockIO u (Either IOException Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException Bool -> MockIO u (Either IOException Bool))
-> Either IOException Bool -> MockIO u (Either IOException Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Either IOException Bool
forall a b. b -> Either a b
Right (Bool -> Either IOException Bool)
-> Bool -> Either IOException Bool
forall a b. (a -> b) -> a -> b
$ Either String Handle -> FileSystem (Either String Handle) -> Bool
forall a. Eq a => a -> FileSystem a -> Bool
FS.fileExists (String -> Either String Handle
forall a b. a -> Either a b
Left String
path) (FileSystem (Either String Handle) -> Bool)
-> FileSystem (Either String Handle) -> Bool
forall a b. (a -> b) -> a -> b
$ MockWorld u -> FileSystem (Either String Handle)
forall s. MockWorld s -> FileSystem (Either String Handle)
Mock._files MockWorld u
world

  HGetLine Handle
handle -> do
    Int -> MockIO u ()
forall s. Int -> MockIO s ()
Mock.incrementTimer Int
1
    MockWorld u
world <- MockIO u (MockWorld u)
forall s. MockIO s (MockWorld s)
Mock.getMockWorld
    let dne :: IOException
dne = IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
doesNotExistErrorType String
"" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing
    let eof :: IOException
eof = IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
eofErrorType String
"" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing
    let result :: Either IOException (Text, FileSystem (Either String Handle))
result = IOException
-> IOException
-> Either String Handle
-> FileSystem (Either String Handle)
-> Either IOException (Text, FileSystem (Either String Handle))
forall a e.
Eq a =>
e -> e -> a -> FileSystem a -> Either e (Text, FileSystem a)
FS.readLine IOException
dne IOException
eof (Handle -> Either String Handle
forall a b. b -> Either a b
Right Handle
handle) (FileSystem (Either String Handle)
 -> Either IOException (Text, FileSystem (Either String Handle)))
-> FileSystem (Either String Handle)
-> Either IOException (Text, FileSystem (Either String Handle))
forall a b. (a -> b) -> a -> b
$ MockWorld u -> FileSystem (Either String Handle)
forall s. MockWorld s -> FileSystem (Either String Handle)
Mock._files MockWorld u
world
    case Either IOException (Text, FileSystem (Either String Handle))
result of
      Left IOException
err -> Either IOException Text -> MockIO u (Either IOException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException Text -> MockIO u (Either IOException Text))
-> Either IOException Text -> MockIO u (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ IOException -> Either IOException Text
forall a b. a -> Either a b
Left IOException
err
      Right (Text
txt, FileSystem (Either String Handle)
fs) -> do
        (MockWorld u -> MockWorld u) -> MockIO u ()
forall s. (MockWorld s -> MockWorld s) -> MockIO s ()
Mock.modifyMockWorld ((MockWorld u -> MockWorld u) -> MockIO u ())
-> (MockWorld u -> MockWorld u) -> MockIO u ()
forall a b. (a -> b) -> a -> b
$ \MockWorld u
w -> MockWorld u
w { _files :: FileSystem (Either String Handle)
Mock._files = FileSystem (Either String Handle)
fs }
        Either IOException Text -> MockIO u (Either IOException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException Text -> MockIO u (Either IOException Text))
-> Either IOException Text -> MockIO u (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either IOException Text
forall a b. b -> Either a b
Right Text
txt

  HGetLineNoEcho Handle
handle -> do
    Int -> MockIO u ()
forall s. Int -> MockIO s ()
Mock.incrementTimer Int
1
    MockWorld u
world <- MockIO u (MockWorld u)
forall s. MockIO s (MockWorld s)
Mock.getMockWorld
    let dne :: IOException
dne = IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
doesNotExistErrorType String
"" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing
    let eof :: IOException
eof = IOErrorType
-> String -> Maybe Handle -> Maybe String -> IOException
mkIOError IOErrorType
eofErrorType String
"" (Handle -> Maybe Handle
forall a. a -> Maybe a
Just Handle
handle) Maybe String
forall a. Maybe a
Nothing
    let result :: Either IOException (Text, FileSystem (Either String Handle))
result = IOException
-> IOException
-> Either String Handle
-> FileSystem (Either String Handle)
-> Either IOException (Text, FileSystem (Either String Handle))
forall a e.
Eq a =>
e -> e -> a -> FileSystem a -> Either e (Text, FileSystem a)
FS.readLine IOException
dne IOException
eof (Handle -> Either String Handle
forall a b. b -> Either a b
Right Handle
handle) (FileSystem (Either String Handle)
 -> Either IOException (Text, FileSystem (Either String Handle)))
-> FileSystem (Either String Handle)
-> Either IOException (Text, FileSystem (Either String Handle))
forall a b. (a -> b) -> a -> b
$ MockWorld u -> FileSystem (Either String Handle)
forall s. MockWorld s -> FileSystem (Either String Handle)
Mock._files MockWorld u
world
    case Either IOException (Text, FileSystem (Either String Handle))
result of
      Left IOException
err -> Either IOException Text -> MockIO u (Either IOException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException Text -> MockIO u (Either IOException Text))
-> Either IOException Text -> MockIO u (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ IOException -> Either IOException Text
forall a b. a -> Either a b
Left IOException
err
      Right (Text
txt, FileSystem (Either String Handle)
fs) -> do
        (MockWorld u -> MockWorld u) -> MockIO u ()
forall s. (MockWorld s -> MockWorld s) -> MockIO s ()
Mock.modifyMockWorld ((MockWorld u -> MockWorld u) -> MockIO u ())
-> (MockWorld u -> MockWorld u) -> MockIO u ()
forall a b. (a -> b) -> a -> b
$ \MockWorld u
w -> MockWorld u
w { _files :: FileSystem (Either String Handle)
Mock._files = FileSystem (Either String Handle)
fs }
        Either IOException Text -> MockIO u (Either IOException Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IOException Text -> MockIO u (Either IOException Text))
-> Either IOException Text -> MockIO u (Either IOException Text)
forall a b. (a -> b) -> a -> b
$ Text -> Either IOException Text
forall a b. b -> Either a b
Right Text
txt