sandwich-webdriver-0.2.2.0: app/Main.hs

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE CPP #-}

module Main where

import Control.Concurrent
import Control.Monad.IO.Class
import Data.Maybe
import Data.String.Interpolate
import Data.Time.Clock
import Test.Sandwich
import Test.Sandwich.Formatters.Print
import Test.Sandwich.WebDriver
import Test.Sandwich.WebDriver.Windows
import Test.WebDriver

#ifndef mingw32_HOST_OS
import Test.Sandwich.Formatters.TerminalUI
#endif


simple :: TopSpec
simple = introduceWebDriver wdOptions $ do
  it "does the thing 1" $ withSession1 $ do
    openPage "http://www.google.com"
    setWindowLeftSide
    search <- findElem (ByCSS [i|*[title="Search"]|])
    click search
    sendKeys "asdf" search
    liftIO $ threadDelay 1000000
    sendKeys "fdsa" search
    liftIO $ threadDelay 1000000
    sendKeys "jkl" search
    liftIO $ threadDelay 1000000
    findElem (ByCSS ".does-not-exist")
    expectationFailure "OH NO"
  -- it "does the thing 2" $ withSession2 $ do
  --   openPage "http://www.cnn.com"
  --   setWindowRightSide
  --   liftIO $ threadDelay 1000000

-- concurrent :: TopSpec
-- concurrent = introduceWebDriver wdOptions $ parallel $ do
--   it "does the thing 1" $ withSession1 $ do
--     openPage "http://www.google.com"
--     setWindowLeftSide
--     liftIO $ threadDelay 10000000
--   it "does the thing 2" $ withSession2 $ do
--     openPage "http://www.cnn.com"
--     setWindowRightSide
--     liftIO $ threadDelay 10000000

-- pooled :: TopSpec
-- pooled = do
--   introduce "WebDriver pool" webdriverPool doCreatePool (liftIO . purgePool) $ parallel $ do
--     it "works" (2 `shouldBe` 2)

--     claimWebDriver $ do
--       it "does the thing 1" $ withSession1 $ do
--         openPage "http://www.google.com"
--         setWindowLeftSide
--         liftIO $ threadDelay 1000000

--     claimWebDriver $ do
--       it "does the thing 2" $ withSession1 $ do
--         openPage "http://www.cnn.com"
--         setWindowRightSide
--         liftIO $ threadDelay 1000000

-- doCreatePool = do
--   maybeRunRoot <- getRunRoot
--   let runRoot = fromMaybe "/tmp" maybeRunRoot
--   liftIO $ createPool (allocateWebDriver' runRoot wdOptions) cleanupWebDriver' 1 (5) 4

-- claimWebDriver subspec = introduceWith "Claim webdriver" webdriver wrappedAction subspec
--   where wrappedAction action = do
--           pool <- getContext webdriverPool
--           debug "Trying to claim webdriver"
--           withResource pool (liftIO . action)

-- webdriverPool = Label :: Label "webdriverPool" (Pool WdSession)

wdOptions = (defaultWdOptions "/tmp/tools") {
  -- capabilities = chromeCapabilities
  capabilities = firefoxCapabilities Nothing
  -- capabilities = headlessFirefoxCapabilities
  , saveSeleniumMessageHistory = Always
  -- , runMode = Normal
  , runMode = RunHeadless defaultHeadlessConfig
  }

testOptions = defaultOptions {
  optionsTestArtifactsDirectory = TestArtifactsGeneratedDirectory "test_runs" (show <$> getCurrentTime)
  -- , optionsFormatters = [SomeFormatter defaultTerminalUIFormatter]
  , optionsFormatters = [SomeFormatter defaultPrintFormatter]
  }

main :: IO ()
main = runSandwich testOptions simple