sydtest-webdriver-yesod (empty) → 0.0.0.0
raw patch · 6 files changed
+227/−0 lines, 6 filesdep +basedep +bytestringdep +http-client
Dependencies added: base, bytestring, http-client, http-types, mtl, network-uri, path, path-io, sydtest, sydtest-wai, sydtest-webdriver, sydtest-webdriver-yesod, sydtest-yesod, text, webdriver, yesod
Files
- LICENSE.md +5/−0
- src/Test/Syd/Webdriver/Yesod.hs +108/−0
- sydtest-webdriver-yesod.cabal +65/−0
- test/Spec.hs +1/−0
- test/Test/Syd/Webdriver/Yesod/App.hs +28/−0
- test/Test/Syd/Webdriver/YesodSpec.hs +20/−0
+ LICENSE.md view
@@ -0,0 +1,5 @@+# Sydtest License++Copyright (c) 2022 Tom Sydney Kerckhove++See the Sydtest License at https://github.com/NorfairKing/sydtest/blob/master/sydtest/LICENSE.md for the full license text.
+ src/Test/Syd/Webdriver/Yesod.hs view
@@ -0,0 +1,108 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UndecidableInstances #-}+-- Because of webdriver using dangerous constructors+{-# OPTIONS_GHC -fno-warn-incomplete-record-updates #-}+-- For the undefined trick+{-# OPTIONS_GHC -fno-warn-unused-pattern-binds #-}++-- | This is a helper module for 'Test.Syd.Webdriver' to let you use Yesod+-- routes to define webdriver tests.+module Test.Syd.Webdriver.Yesod+ ( -- * Defining webdriver tests with yesod+ webdriverYesodSpec,++ -- * Implementing webdriver tests with yesod+ openRoute,+ openRouteWithParams,+ getCurrentRoute,+ )+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++-- | Run webdriver tests given a 'SetupFunc' for your app.+webdriverYesodSpec ::+ Yesod.YesodDispatch app =>+ (HTTP.Manager -> SetupFunc app) ->+ WebdriverSpec app ->+ Spec+webdriverYesodSpec appSetupFunc = webdriverSpec $ \man -> do+ site <- appSetupFunc man+ YesodClient {..} <- yesodClientSetupFunc man site+ pure (yesodClientSiteURI, yesodClientSite)++-- | Open a given yesod 'Route'+openRoute ::+ Yesod.RenderRoute app =>+ Route app ->+ WebdriverTestM app ()+openRoute route = openRouteWithParams route []++-- | Open a given yesod 'Route' with parameters+openRouteWithParams ::+ Yesod.RenderRoute app =>+ Route app ->+ [(Text, Text)] ->+ WebdriverTestM app ()+openRouteWithParams route extraParams = do+ let (pathPieces, queryParams) = Yesod.renderRoute route+ let q = queryTextToQuery $ map (second Just) (queryParams <> extraParams)+ let pathBSBuilder = encodePath pathPieces q+ let pathBS = LB.toStrict (BB.toLazyByteString pathBSBuilder)+ case TE.decodeUtf8' pathBS of+ Left err ->+ liftIO $+ expectationFailure $+ unlines+ [ unwords+ [ "Failed to decode path from bytestring:",+ show pathBS+ ],+ show err+ ]+ Right t -> openPath $ T.unpack t++-- | Get the current 'Route'+getCurrentRoute ::+ Yesod.ParseRoute app =>+ WebdriverTestM app (Route app)+getCurrentRoute = do+ currentUrl <- getCurrentURL+ case parseURI currentUrl of+ Nothing -> liftIO $ expectationFailure $ "Should have been able to parse the current url into an URI: " <> currentUrl+ Just URI {..} -> do+ let (textPieces, query_) = HTTP.decodePath $ TE.encodeUtf8 $ T.pack $ concat [uriPath, uriQuery]+ queryPieces = map unJust $ HTTP.queryToQueryText query_+ case Yesod.parseRoute (textPieces, queryPieces) of+ Nothing ->+ liftIO $+ expectationFailure $+ unlines+ [ "Should have been able to parse an App route from " <> currentUrl,+ ppShow (textPieces, queryPieces)+ ]+ Just route -> pure route+ where+ unJust (a, Just b) = (a, b)+ unJust (a, Nothing) = (a, "")
+ sydtest-webdriver-yesod.cabal view
@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.6.+--+-- see: https://github.com/sol/hpack++name: sydtest-webdriver-yesod+version: 0.0.0.0+synopsis: A webdriver+yesod companion library for sydtest+category: Testing+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright (c) 2022 Tom Sydney Kerckhove+license: OtherLicense+license-file: LICENSE.md+build-type: Simple+extra-source-files:+ LICENSE.md++library+ exposed-modules:+ Test.Syd.Webdriver.Yesod+ other-modules:+ Paths_sydtest_webdriver_yesod+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , bytestring+ , http-client+ , http-types+ , mtl+ , network-uri+ , path+ , path-io+ , sydtest+ , sydtest-wai+ , sydtest-webdriver+ , sydtest-yesod+ , text+ , webdriver+ , yesod+ default-language: Haskell2010++test-suite sydtest-webdriver-yesod-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ other-modules:+ Test.Syd.Webdriver.Yesod.App+ Test.Syd.Webdriver.YesodSpec+ Paths_sydtest_webdriver_yesod+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-tool-depends:+ sydtest-discover:sydtest-discover+ build-depends:+ base >=4.7 && <5+ , path+ , path-io+ , sydtest+ , sydtest-webdriver+ , sydtest-webdriver-yesod+ , yesod+ default-language: Haskell2010
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF sydtest-discover #-}
+ test/Test/Syd/Webdriver/Yesod/App.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}++module Test.Syd.Webdriver.Yesod.App where++import Yesod++data App = App {appSessionKeyFile :: !FilePath}++mkYesod+ "App"+ [parseRoutes|++ / HomeR GET+|]++instance Yesod App where+ makeSessionBackend App {..} = Just <$> defaultClientSessionBackend 30 appSessionKeyFile++instance RenderMessage App FormMessage where+ renderMessage _ _ = defaultFormMessage++getHomeR :: Handler Html+getHomeR = pure "Hello, world! (GET)"
+ test/Test/Syd/Webdriver/YesodSpec.hs view
@@ -0,0 +1,20 @@+module Test.Syd.Webdriver.YesodSpec (spec) where++import Path+import Path.IO+import Test.Syd+import Test.Syd.Path+import Test.Syd.Webdriver+import Test.Syd.Webdriver.Yesod+import Test.Syd.Webdriver.Yesod.App++spec :: Spec+spec = exampleAppSpec $ do+ it "can navigate to home" $+ openRoute HomeR++exampleAppSpec :: WebdriverSpec App -> Spec+exampleAppSpec = webdriverYesodSpec $ \_ -> do+ tdir <- tempDirSetupFunc "sydtest-yesod"+ sessionKeyFile <- resolveFile tdir "client_session_key.aes"+ pure $ App {appSessionKeyFile = fromAbsFile sessionKeyFile}