{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}
{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}
module Test.Syd.Webdriver.Yesod
(
webdriverYesodSpec,
openRoute,
openRouteWithParams,
getCurrentRoute,
currentRouteShouldBe,
getLinkTextI,
findElemByLinkTextI,
findElemByPartialLinkTextI,
findElemByButtonTextI,
)
where
import Control.Arrow
import Control.Monad.Reader
import qualified Data.ByteString.Builder as BB
import qualified Data.ByteString.Lazy as LB
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Network.HTTP.Client as HTTP
import qualified Network.HTTP.Types as HTTP
import Network.URI
import Test.Syd
import Test.Syd.Wai
import Test.Syd.Webdriver
import Test.Syd.Yesod
import Test.WebDriver as WD hiding (setWindowSize)
import qualified Yesod
webdriverYesodSpec ::
Yesod.YesodDispatch app =>
(HTTP.Manager -> SetupFunc app) ->
WebdriverSpec app ->
Spec
webdriverYesodSpec :: forall app.
YesodDispatch app =>
(Manager -> SetupFunc app) -> WebdriverSpec app -> Spec
webdriverYesodSpec Manager -> SetupFunc app
appSetupFunc = forall app.
(Manager -> SetupFunc (URI, app)) -> WebdriverSpec app -> Spec
webdriverSpec forall a b. (a -> b) -> a -> b
$ \Manager
man -> do
app
site <- Manager -> SetupFunc app
appSetupFunc Manager
man
YesodClient {app
URI
Manager
yesodClientSite :: forall site. YesodClient site -> site
yesodClientManager :: forall site. YesodClient site -> Manager
yesodClientSiteURI :: forall site. YesodClient site -> URI
yesodClientSiteURI :: URI
yesodClientManager :: Manager
yesodClientSite :: app
..} <- forall site.
YesodDispatch site =>
Manager -> site -> SetupFunc (YesodClient site)
yesodClientSetupFunc Manager
man app
site
forall (f :: * -> *) a. Applicative f => a -> f a
pure (URI
yesodClientSiteURI, app
yesodClientSite)
openRoute ::
Yesod.RenderRoute app =>
Route app ->
WebdriverTestM app ()
openRoute :: forall app. RenderRoute app => Route app -> WebdriverTestM app ()
openRoute Route app
route = forall app.
RenderRoute app =>
Route app -> [(Text, Text)] -> WebdriverTestM app ()
openRouteWithParams Route app
route []
openRouteWithParams ::
Yesod.RenderRoute app =>
Route app ->
[(Text, Text)] ->
WebdriverTestM app ()
openRouteWithParams :: forall app.
RenderRoute app =>
Route app -> [(Text, Text)] -> WebdriverTestM app ()
openRouteWithParams Route app
route [(Text, Text)]
extraParams = do
let ([Text]
pathPieces, [(Text, Text)]
queryParams) = forall a. RenderRoute a => Route a -> ([Text], [(Text, Text)])
Yesod.renderRoute Route app
route
let q :: Query
q = QueryText -> Query
queryTextToQuery forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second forall a. a -> Maybe a
Just) ([(Text, Text)]
queryParams forall a. Semigroup a => a -> a -> a
<> [(Text, Text)]
extraParams)
let pathBSBuilder :: Builder
pathBSBuilder = [Text] -> Query -> Builder
encodePath [Text]
pathPieces Query
q
let pathBS :: ByteString
pathBS = ByteString -> ByteString
LB.toStrict (Builder -> ByteString
BB.toLazyByteString Builder
pathBSBuilder)
case ByteString -> Either UnicodeException Text
TE.decodeUtf8' ByteString
pathBS of
Left UnicodeException
err ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> IO a
expectationFailure forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines
[ [String] -> String
unwords
[ String
"Failed to decode path from bytestring:",
forall a. Show a => a -> String
show ByteString
pathBS
],
forall a. Show a => a -> String
show UnicodeException
err
]
Right Text
t -> forall app. String -> WebdriverTestM app ()
openPath forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
t
getCurrentRoute ::
Yesod.ParseRoute app =>
WebdriverTestM app (Route app)
getCurrentRoute :: forall app. ParseRoute app => WebdriverTestM app (Route app)
getCurrentRoute = do
String
currentUrl <- forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd String
getCurrentURL
case String -> Maybe URI
parseURI String
currentUrl of
Maybe URI
Nothing -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> IO a
expectationFailure forall a b. (a -> b) -> a -> b
$ String
"Should have been able to parse the current url into an URI: " forall a. Semigroup a => a -> a -> a
<> String
currentUrl
Just URI {String
Maybe URIAuth
uriScheme :: URI -> String
uriAuthority :: URI -> Maybe URIAuth
uriPath :: URI -> String
uriQuery :: URI -> String
uriFragment :: URI -> String
uriFragment :: String
uriQuery :: String
uriPath :: String
uriAuthority :: Maybe URIAuth
uriScheme :: String
..} -> do
let ([Text]
textPieces, Query
query_) = ByteString -> ([Text], Query)
HTTP.decodePath forall a b. (a -> b) -> a -> b
$ Text -> ByteString
TE.encodeUtf8 forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
uriPath, String
uriQuery]
queryPieces :: [(Text, Text)]
queryPieces = forall a b. (a -> b) -> [a] -> [b]
map forall {b} {a}. IsString b => (a, Maybe b) -> (a, b)
unJust forall a b. (a -> b) -> a -> b
$ Query -> QueryText
HTTP.queryToQueryText Query
query_
case forall a.
ParseRoute a =>
([Text], [(Text, Text)]) -> Maybe (Route a)
Yesod.parseRoute ([Text]
textPieces, [(Text, Text)]
queryPieces) of
Maybe (Route app)
Nothing ->
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
forall a. HasCallStack => String -> IO a
expectationFailure forall a b. (a -> b) -> a -> b
$
[String] -> String
unlines
[ String
"Should have been able to parse an App route from " forall a. Semigroup a => a -> a -> a
<> String
currentUrl,
forall a. Show a => a -> String
ppShow ([Text]
textPieces, [(Text, Text)]
queryPieces)
]
Just Route app
route -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Route app
route
where
unJust :: (a, Maybe b) -> (a, b)
unJust (a
a, Just b
b) = (a
a, b
b)
unJust (a
a, Maybe b
Nothing) = (a
a, b
"")
currentRouteShouldBe ::
(Show (Route app), Yesod.ParseRoute app) =>
Route app ->
WebdriverTestM app ()
currentRouteShouldBe :: forall app.
(Show (Route app), ParseRoute app) =>
Route app -> WebdriverTestM app ()
currentRouteShouldBe Route app
expected = do
Route app
actual <- forall app. ParseRoute app => WebdriverTestM app (Route app)
getCurrentRoute
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Route app
actual forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Route app
expected
getLinkTextI :: Yesod.RenderMessage app message => message -> WebdriverTestM app Text
getLinkTextI :: forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Text
getLinkTextI message
message = do
app
y <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall app. WebdriverTestEnv app -> app
webdriverTestEnvApp
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall master message.
RenderMessage master message =>
master -> [Text] -> message -> Text
Yesod.renderMessage app
y [] message
message
findElemByLinkTextI :: Yesod.RenderMessage app message => message -> WebdriverTestM app Element
findElemByLinkTextI :: forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Element
findElemByLinkTextI message
message = forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Text
getLinkTextI message
message forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Selector -> wd Element
findElem forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Selector
ByLinkText
findElemByPartialLinkTextI :: Yesod.RenderMessage app message => message -> WebdriverTestM app Element
findElemByPartialLinkTextI :: forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Element
findElemByPartialLinkTextI message
message = forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Text
getLinkTextI message
message forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Selector -> wd Element
findElem forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Selector
ByPartialLinkText
findElemByButtonTextI :: Yesod.RenderMessage app message => message -> WebdriverTestM app Element
findElemByButtonTextI :: forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Element
findElemByButtonTextI message
message = do
Text
t <- forall app message.
RenderMessage app message =>
message -> WebdriverTestM app Text
getLinkTextI message
message
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Selector -> wd Element
findElem forall a b. (a -> b) -> a -> b
$ Text -> Selector
ByXPath forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat [Text
"//button[normalize-space()=\"", Text
t, Text
"\"]"]