{-# LANGUAGE OverloadedStrings, FlexibleInstances, DeriveDataTypeable, TypeFamilies, CPP, NamedFieldPuns #-}
-- | Write hspec tests that are webdriver tests, automatically managing the webdriver sessions.
--
-- This module re-exports functions from "Test.Hspec" and "Test.WebDriver.Commands" and it is
-- intended that you just import @Test.Hspec.WebDriver@.  If you need to import @Test.Hspec@ or
-- @Test.WebDriver@, you should do so using a qualified import.
--
-- >{-# LANGUAGE OverloadedStrings #-}
-- >module XKCD where
-- >
-- >import Test.Hspec.WebDriver
-- >
-- >allBrowsers :: [Capabilities]
-- >allBrowsers = [firefoxCaps, chromeCaps, ieCaps]
-- >
-- >browsersExceptIE :: [Capabilities]
-- >browsersExceptIE = [firefoxCaps, chromeCaps]
-- >
-- >main :: IO ()
-- >main = hspec $
-- >    describe "XKCD Tests" $ do
-- >
-- >        session "for 327" $ using allBrowsers $ do
-- >            it "opens the page" $ runWD $
-- >                openPage "http://www.xkcd.com/327/"
-- >            it "checks hover text" $ runWD $ do
-- >                e <- findElem $ ByCSS "div#comic > img"
-- >                e `shouldBeTag` "img"
-- >                e `shouldHaveAttr` ("title", "Her daughter is named Help I'm trapped in a driver's license factory.")
-- >
-- >        parallel $ session "for 303" $ using browsersExceptIE $ do
-- >            it "opens the page" $ runWD $
-- >                openPage "http://www.xkcd.com/303/"
-- >            it "checks the title" $ runWD $ do
-- >                e <- findElem $ ById "ctitle"
-- >                e `shouldBeTag` "div"
-- >                e `shouldHaveText` "Compiling"
--
-- The above code assumes selenium-server-standalone is running on @127.0.0.1:4444@ at path
-- @\/wd\/hub@ (this is the default).
module Test.Hspec.WebDriver(
  -- * Webdriver Example
    WdExample(..)
  , WdOptions (..)
  , runWD
  , runWDOptions
  , runWDWith
  , runWDWithOptions
  , pending
  , pendingWith
  , example

  -- * Webdriver Sessions
  , session
  , sessionWith
  , inspectSession
  , using
  , WdTestSession

  -- * Default Capabilities
  , firefoxCaps
  , chromeCaps
  , ieCaps
  , operaCaps
  , iphoneCaps
  , ipadCaps
  , androidCaps

  -- * Expectations
  , shouldBe
  , shouldBeTag
  , shouldHaveText
  , shouldHaveAttr
  , shouldReturn
  , shouldThrow

  -- * Re-exports from "Test.Hspec"
  , hspec
  , Spec
  , SpecWith
  , describe
  , context
  , it
  , specify
  , parallel
  , runIO

  -- * Re-exports from "Test.WebDriver"
  , WD
  , Capabilities
  , module Test.WebDriver.Commands
) where

import Control.Concurrent.MVar (MVar, takeMVar, putMVar, newEmptyMVar)
import Control.Exception (SomeException(..))
import Control.Exception.Lifted (try, Exception, onException, throwIO)
import Control.Monad (replicateM)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (state, evalState, execState)
import Data.Default (Default(..))
import Data.IORef (newIORef, writeIORef, readIORef)
import qualified Data.Text as T
import Data.Typeable (Typeable, cast)
import Test.HUnit (assertEqual, assertFailure)
import qualified Data.Aeson as A

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), Applicative)
import Data.Traversable (traverse)
#endif

import qualified Test.Hspec as H
import Test.Hspec hiding (shouldReturn, shouldBe, shouldSatisfy, shouldThrow, pending, pendingWith, example)
import Test.Hspec.Core.Spec (Result(..), ResultStatus(..))
import Test.Hspec.Core.Spec (Item(..), Example(..), SpecTree, Tree(..), fromSpecList, runSpecM)

import Test.WebDriver (WD, Capabilities)
import qualified Test.WebDriver as W
import Test.WebDriver.Commands
import qualified Test.WebDriver.Config as W
import qualified Test.WebDriver.Capabilities as W
import qualified Test.WebDriver.Session as W

-- | The state passed between examples inside the mvars.
data SessionState multi = SessionState {
    -- | The already created sessions
    SessionState multi -> [(multi, WDSession)]
stSessionMap :: [(multi, W.WDSession)]
    -- | True if the previous example had an error
  , SessionState multi -> Bool
stPrevHadError :: Bool
    -- | True if the previous example was aborted with 'inspectSession'
  , SessionState multi -> Bool
stPrevAborted :: Bool
    -- | Create a new session
  , SessionState multi -> IO WDSession
stCreateSession :: IO W.WDSession
}

-- | Internal state for webdriver test sessions.
data WdTestSession multi = WdTestSession {
    WdTestSession multi -> IO (SessionState multi)
wdTestOpen :: IO (SessionState multi)
  , WdTestSession multi -> SessionState multi -> IO ()
wdTestClose :: SessionState multi -> IO ()
}

-- | A webdriver example.
--
-- The webdriver action of type @'WD' ()@ should interact with the webpage using commands from
-- "Test.WebDriver.Commands" (which is re-exported from this module) and then use the
-- <#g:4 expectations> in this module.  It is possible to split up the spec of a single page into multiple
-- examples where later examples start with the web browser state from the end of the previous
-- example.  This is helpful to keep each individual example small and allows the entire spec to be
-- described at the beginning with pending examples.
--
-- The way this works is that you combine examples into a session using 'session' or 'sessionWith'.
-- A webdriver session is then threaded through all examples in a session so that a later example in
-- the session can rely on the webbrowser state as set up by the previous example.  The type system
-- enforces that every webdriver example must be located within a call to 'session' or
-- 'sessionWith'.  Indeed, a 'WdExample' produces a @'SpecWith' ('WdTestSession' multi)@ which can
-- only be converted to 'Spec' using 'session' or 'sessionWith'.  The reason for the 'WdPending'
-- constructor is so that a pending example can be specified with type @'SpecWith' ('WdTestSession'
-- multi)@ so it can compose with the other webdriver examples.
--
-- The type @multi@ is used when testing multiple sessions at once (e.g. to test multiple
-- interacting users), otherwise it is @()@. Values of this type are used to determine which browser
-- session the example should be executed against.  A new session is created every time a new value
-- of type @multi@ is seen.  Note that the type system enforces that every example within the
-- session has the same type @multi@.
data WdExample multi = WdExample multi WdOptions (WD ()) | WdPending (Maybe String)

-- | Optional options that can be passed to 'runWDOptions'.
data WdOptions = WdOptions {
  -- | As soon as an example fails, skip all remaining tests in the session.  Defaults to True.
  WdOptions -> Bool
skipRemainingTestsAfterFailure :: Bool
  }

instance Default WdOptions where
  def :: WdOptions
def = WdOptions :: Bool -> WdOptions
WdOptions { skipRemainingTestsAfterFailure :: Bool
skipRemainingTestsAfterFailure = Bool
True }

-- | A shorthand for constructing a 'WdExample' from a webdriver action when you are only testing a
-- single browser session at once.  See the XKCD example at the top of the page.
runWD :: WD () -> WdExample ()
runWD :: WD () -> WdExample ()
runWD = () -> WdOptions -> WD () -> WdExample ()
forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample () WdOptions
forall a. Default a => a
def

-- | A version of runWD that accepts some custom options
runWDOptions :: WdOptions -> WD () -> WdExample ()
runWDOptions :: WdOptions -> WD () -> WdExample ()
runWDOptions = () -> WdOptions -> WD () -> WdExample ()
forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample ()

-- | Create a webdriver example, specifying which of the multiple sessions the example should be
-- executed against.  I suggest you create an enumeration for multi, for example:
--
-- >data TestUser = Gandolf | Bilbo | Legolas
-- >    deriving (Show, Eq, Enum, Bounded)
-- >
-- >runUser :: TestUser -> WD () -> WDExample TestUser
-- >runUser = runWDWith
-- >
-- >spec :: Spec
-- >spec = session "tests some page" $ using [firefoxCaps] $ do
-- >    it "does something with Gandolf" $ runUser Gandolf $ do
-- >        openPage ...
-- >    it "does something with Bilbo" $ runUser Bilbo $ do
-- >        openPage ...
-- >    it "goes back to the Gandolf session" $ runUser Gandolf $ do
-- >        e <- findElem ....
-- >        ...
--
-- In the above code, two sessions are created and the examples will go back and forth between the
-- two sessions.  Note that a session for Legolas will only be created the first time he shows up in
-- a call to @runUser@, which might be never.  To share information between the sessions (e.g. some
-- data that Gandolf creates that Bilbo should expect), the best way I have found is to use IORefs
-- created with 'runIO' (wrapped in a utility module).
runWDWith :: multi -> WD () -> WdExample multi
runWDWith :: multi -> WD () -> WdExample multi
runWDWith multi
multi = multi -> WdOptions -> WD () -> WdExample multi
forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample multi
multi WdOptions
forall a. Default a => a
def

-- | A version of runWDWith that accepts some custom options
runWDWithOptions :: multi -> WdOptions -> WD () -> WdExample multi
runWDWithOptions :: multi -> WdOptions -> WD () -> WdExample multi
runWDWithOptions = multi -> WdOptions -> WD () -> WdExample multi
forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample

-- | A pending example.
pending :: WdExample multi
pending :: WdExample multi
pending = Maybe String -> WdExample multi
forall multi. Maybe String -> WdExample multi
WdPending Maybe String
forall a. Maybe a
Nothing

-- | A pending example with a message.
pendingWith :: String -> WdExample multi
pendingWith :: String -> WdExample multi
pendingWith = Maybe String -> WdExample multi
forall multi. Maybe String -> WdExample multi
WdPending (Maybe String -> WdExample multi)
-> (String -> Maybe String) -> String -> WdExample multi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe String
forall a. a -> Maybe a
Just

-- | A version of 'H.example' which lifts an @IO ()@ to a webdriver example (so it can be composed
-- with other webdriver examples).  In the case of multiple sessions, it doesn't really matter which
-- session the expectation is executed against, so a default value is used.  In the case of single
-- sessions, the type is @WdExample ()@.
example :: Default multi => Expectation -> WdExample multi
example :: IO () -> WdExample multi
example = multi -> WdOptions -> WD () -> WdExample multi
forall multi. multi -> WdOptions -> WD () -> WdExample multi
WdExample multi
forall a. Default a => a
def WdOptions
forall a. Default a => a
def (WD () -> WdExample multi)
-> (IO () -> WD ()) -> IO () -> WdExample multi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Combine the examples nested inside this call into a webdriver session or multiple sessions.
-- For each of the capabilities in the list, the examples are executed one at a time in depth-first
-- order and so later examples can rely on the browser state created by earlier examples.  These
-- passes through the examples are independent for different capabilities.  Note that when using
-- 'parallel', the examples within a single pass still execute serially.  Different passes through
-- the examples will be executed in parallel.  The sessions are managed as follows:
--
-- * In the simplest case when @multi@ is @()@, before the first example is executed a new webdriver
-- session with the given capabilities is created.  The examples are then executed in depth-first
-- order, and the session is then closed when either an exception occurs or the examples complete.
-- (The session can be left open with 'inspectSession').
--
-- * More generally, as the examples are executed, each time a new value of type @multi@ is seen, a
-- new webdriver session with the capabilities is automatically created.  Later examples will
-- continue with the session matching their value of @multi@.
--
-- This function uses the default webdriver host (127.0.0.1), port (4444), and basepath
-- (@\/wd\/hub@).
session :: String -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec
session :: String -> ([Capabilities], SpecWith (WdTestSession multi)) -> Spec
session String
msg ([Capabilities]
caps, SpecWith (WdTestSession multi)
spec) = WDConfig
-> String
-> ([(Capabilities, String)], SpecWith (WdTestSession multi))
-> Spec
forall multi.
WDConfig
-> String
-> ([(Capabilities, String)], SpecWith (WdTestSession multi))
-> Spec
sessionWith WDConfig
W.defaultConfig String
msg ([(Capabilities, String)]
caps', SpecWith (WdTestSession multi)
spec)
  where
    caps' :: [(Capabilities, String)]
caps' = (Capabilities -> (Capabilities, String))
-> [Capabilities] -> [(Capabilities, String)]
forall a b. (a -> b) -> [a] -> [b]
map Capabilities -> (Capabilities, String)
f [Capabilities]
caps
    f :: Capabilities -> (Capabilities, String)
f Capabilities
c = case Browser -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Capabilities -> Browser
W.browser Capabilities
c) of
      A.String Text
b -> (Capabilities
c, Text -> String
T.unpack Text
b)
      Value
_ -> (Capabilities
c, Capabilities -> String
forall a. Show a => a -> String
show Capabilities
c) -- this should not be the case, every browser toJSON is a string

-- | A variation of 'session' which allows you to specify the webdriver configuration.  Note that
-- the capabilities in the 'W.WDConfig' will be ignored, instead the capabilities will come from the
-- list of 'Capabilities' passed to 'sessionWith'.
--
-- In addition, each capability is paired with a descriptive string which is passed to hspec to
-- describe the example.  By default, 'session' uses the browser name as the description.  'sessionWith'
-- supports a more detailed description so that in the hspec output you can distinguish between
-- capabilities that share the same browser but differ in the details, for example capabilities with and
-- without javascript.
sessionWith :: W.WDConfig -> String -> ([(Capabilities, String)], SpecWith (WdTestSession multi)) -> Spec
sessionWith :: WDConfig
-> String
-> ([(Capabilities, String)], SpecWith (WdTestSession multi))
-> Spec
sessionWith WDConfig
cfg String
msg ([(Capabilities, String)]
caps, SpecWith (WdTestSession multi)
spec) = Spec
spec'
    where
        procT :: Capabilities -> Spec
procT Capabilities
c = WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
forall multi.
WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession WDConfig
cfg (Capabilities -> Capabilities
forall t. GetCapabilities t => t -> Capabilities
W.getCaps Capabilities
c) SpecWith (WdTestSession multi)
spec
        spec' :: Spec
spec' = case [(Capabilities, String)]
caps of
                    [] -> String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
msg (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ HasCallStack => String -> IO ()
String -> IO ()
H.pendingWith String
"No capabilities specified"
                    [(Capabilities
c,String
cDscr)] -> String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
msg String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cDscr) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Capabilities -> Spec
procT Capabilities
c
                    [(Capabilities, String)]
_ -> String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
msg (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ ((Capabilities, String) -> Spec)
-> [(Capabilities, String)] -> Spec
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(Capabilities
c,String
cDscr) -> String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe (String
"using " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cDscr) (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ Capabilities -> Spec
procT Capabilities
c) [(Capabilities, String)]
caps

-- | A synonym for constructing pairs that allows the word @using@ to be used with 'session' so that the session
-- description reads like a sentance.
--
-- >allBrowsers :: [Capabilities]
-- >allBrowsers = [firefoxCaps, chromeCaps, ieCaps]
-- >
-- >browsersExceptIE :: [Capabilities]
-- >browsersExceptIE = [firefoxCaps, chromeCaps]
-- >
-- >mobileBrowsers :: [Capabilities]
-- >mobileBrowsers = [iphoneCaps, ipadCaps, androidCaps]
-- >
-- >myspec :: Spec
-- >myspec = do
-- >  session "for the home page" $ using allBrowsers $ do
-- >    it "loads the page" $ runWD $ do
-- >        ...
-- >    it "scrolls the carosel" $ runWD $ do
-- >        ...
-- >  session "for the users page" $ using browsersExceptIE $ do
-- >    ...
using :: [caps] -> SpecWith (WdTestSession multi) -> ([caps], SpecWith (WdTestSession multi))
using :: [caps]
-> SpecWith (WdTestSession multi)
-> ([caps], SpecWith (WdTestSession multi))
using = (,)

-- | Default capabilities which can be used in the list passed to 'using'.  I suggest creating a
-- top-level definition such as @allBrowsers@ and @browsersWithoutIE@ such as in the XKCD example at
-- the top of the page, so that you do not specify the browsers in the individual spec.
firefoxCaps, chromeCaps, ieCaps, operaCaps, iphoneCaps, ipadCaps, androidCaps :: Capabilities
firefoxCaps :: Capabilities
firefoxCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.firefox }
chromeCaps :: Capabilities
chromeCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.chrome }
ieCaps :: Capabilities
ieCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.ie }
operaCaps :: Capabilities
operaCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.opera }
iphoneCaps :: Capabilities
iphoneCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.iPhone }
ipadCaps :: Capabilities
ipadCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.iPad }
androidCaps :: Capabilities
androidCaps = Capabilities
W.defaultCaps { browser :: Browser
W.browser = Browser
W.android }

data AbortSession = AbortSession
    deriving (Int -> AbortSession -> String -> String
[AbortSession] -> String -> String
AbortSession -> String
(Int -> AbortSession -> String -> String)
-> (AbortSession -> String)
-> ([AbortSession] -> String -> String)
-> Show AbortSession
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [AbortSession] -> String -> String
$cshowList :: [AbortSession] -> String -> String
show :: AbortSession -> String
$cshow :: AbortSession -> String
showsPrec :: Int -> AbortSession -> String -> String
$cshowsPrec :: Int -> AbortSession -> String -> String
Show, Typeable)
instance Exception AbortSession

-- | Abort the session without closing the session.
--
-- Normally, 'session' will automatically close the session either when the tests complete without
-- error or when any of the tests within the session throws an error.  When developing the test
-- suite, this can be annoying since closing the session causes the browser window to close.
-- Therefore, while developing the test suite, you can insert a call to 'inspectSession'.  This will
-- immedietly halt the session (all later tests will fail) but will not close the session so that
-- the browser window stays open.
inspectSession :: WD ()
inspectSession :: WD ()
inspectSession = AbortSession -> WD ()
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO AbortSession
AbortSession

-- | 'H.shouldBe' lifted into the 'WD' monad.
shouldBe :: (Show a, Eq a) => a -> a -> WD ()
a
x shouldBe :: a -> a -> WD ()
`shouldBe` a
y = IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ a
x a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`H.shouldBe` a
y

-- | Asserts that the given element matches the given tag.
shouldBeTag :: Element -> T.Text -> WD ()
Element
e shouldBeTag :: Element -> Text -> WD ()
`shouldBeTag` Text
name = do
    Text
t <- Element -> WD Text
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd Text
tagName Element
e
    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> Text -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual (String
"tag of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
e) Text
name Text
t

-- | Asserts that the given element has the given text.
shouldHaveText :: Element -> T.Text -> WD ()
Element
e shouldHaveText :: Element -> Text -> WD ()
`shouldHaveText` Text
txt = do
    Text
t <- Element -> WD Text
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> wd Text
getText Element
e
    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> Text -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual (String
"text of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
e) Text
txt Text
t

-- | Asserts that the given elemnt has the attribute given by @(attr name, value)@.
shouldHaveAttr :: Element -> (T.Text, T.Text) -> WD ()
Element
e shouldHaveAttr :: Element -> (Text, Text) -> WD ()
`shouldHaveAttr` (Text
a, Text
txt) = do
    Maybe Text
t <- Element -> Text -> WD (Maybe Text)
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Element -> Text -> wd (Maybe Text)
attr Element
e Text
a
    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ String -> Maybe Text -> Maybe Text -> IO ()
forall a. (HasCallStack, Eq a, Show a) => String -> a -> a -> IO ()
assertEqual (String
"attribute " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
a String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Element -> String
forall a. Show a => a -> String
show Element
e) (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
txt) Maybe Text
t

-- | Asserts that the action returns the expected result.
shouldReturn :: (Show a, Eq a) => WD a -> a -> WD ()
WD a
action shouldReturn :: WD a -> a -> WD ()
`shouldReturn` a
expected = WD a
action WD a -> (a -> WD ()) -> WD ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\a
a -> IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ a
a a -> a -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`H.shouldBe` a
expected)

-- | Asserts that the action throws an exception.
shouldThrow :: (Show e, Eq e, Exception e) => WD a -> e -> WD ()
shouldThrow :: WD a -> e -> WD ()
shouldThrow WD a
w e
expected = do
    Either e a
r <- WD a -> WD (Either e a)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try WD a
w
    case Either e a
r of
        Left e
err -> e
err e -> e -> WD ()
forall a. (Show a, Eq a) => a -> a -> WD ()
`shouldBe` e
expected
        Right a
_ -> IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
forall a. HasCallStack => String -> IO a
assertFailure (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"did not get expected exception " String -> String -> String
forall a. [a] -> [a] -> [a]
++ e -> String
forall a. Show a => a -> String
show e
expected

--------------------------------------------------------------------------------
-- Internal Test Runner
--------------------------------------------------------------------------------

-- | Create a WdTestSession.
createTestSession :: W.WDConfig -> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession :: WDConfig
-> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n = IO (SessionState multi)
-> (SessionState multi -> IO ()) -> WdTestSession multi
forall multi.
IO (SessionState multi)
-> (SessionState multi -> IO ()) -> WdTestSession multi
WdTestSession IO (SessionState multi)
open SessionState multi -> IO ()
close
    where
        open :: IO (SessionState multi)
open | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = SessionState multi -> IO (SessionState multi)
forall (m :: * -> *) a. Monad m => a -> m a
return (SessionState multi -> IO (SessionState multi))
-> SessionState multi -> IO (SessionState multi)
forall a b. (a -> b) -> a -> b
$ [(multi, WDSession)]
-> Bool -> Bool -> IO WDSession -> SessionState multi
forall multi.
[(multi, WDSession)]
-> Bool -> Bool -> IO WDSession -> SessionState multi
SessionState [] Bool
False Bool
False IO WDSession
create
             | Bool
otherwise = MVar (SessionState multi) -> IO (SessionState multi)
forall a. MVar a -> IO a
takeMVar ([MVar (SessionState multi)]
mvars [MVar (SessionState multi)] -> Int -> MVar (SessionState multi)
forall a. [a] -> Int -> a
!! Int
n)

        create :: IO WDSession
create = do
            WDSession
s <- WDConfig -> IO WDSession
forall c (m :: * -> *).
(WebDriverConfig c, MonadBase IO m) =>
c -> m WDSession
W.mkSession WDConfig
cfg
#if MIN_VERSION_webdriver(0,7,0)
            WDSession -> WD WDSession -> IO WDSession
forall a. WDSession -> WD a -> IO a
W.runWD WDSession
s (WD WDSession -> IO WDSession) -> WD WDSession -> IO WDSession
forall a b. (a -> b) -> a -> b
$ Capabilities -> WD WDSession
forall (wd :: * -> *).
(HasCallStack, WebDriver wd) =>
Capabilities -> wd WDSession
createSession (Capabilities -> WD WDSession) -> Capabilities -> WD WDSession
forall a b. (a -> b) -> a -> b
$ WDConfig -> Capabilities
W.wdCapabilities WDConfig
cfg
#else
            W.runWD s $ createSession [] $ W.wdCapabilities cfg
#endif

        close :: SessionState multi -> IO ()
close SessionState multi
st | [MVar (SessionState multi)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MVar (SessionState multi)]
mvars Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n = ((multi, WDSession) -> IO ()) -> [(multi, WDSession)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
`W.runWD` WD ()
forall (wd :: * -> *). (HasCallStack, WebDriver wd) => wd ()
closeSession) (WDSession -> IO ())
-> ((multi, WDSession) -> WDSession) -> (multi, WDSession) -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (multi, WDSession) -> WDSession
forall a b. (a, b) -> b
snd) ([(multi, WDSession)] -> IO ()) -> [(multi, WDSession)] -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionState multi -> [(multi, WDSession)]
forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
st
                 | Bool
otherwise = MVar (SessionState multi) -> SessionState multi -> IO ()
forall a. MVar a -> a -> IO ()
putMVar ([MVar (SessionState multi)]
mvars [MVar (SessionState multi)] -> Int -> MVar (SessionState multi)
forall a. [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)) SessionState multi
st

-- | Convert a single test item to a generic item by providing it with the WdTestSession.
procSpecItem :: W.WDConfig -> [MVar (SessionState multi)] -> Int -> Item (WdTestSession multi) -> Item ()
procSpecItem :: WDConfig
-> [MVar (SessionState multi)]
-> Int
-> Item (WdTestSession multi)
-> Item ()
procSpecItem WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n Item (WdTestSession multi)
item = Item (WdTestSession multi)
item { itemExample :: Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
itemExample = \Params
p ActionWith () -> IO ()
act ProgressCallback
progress -> Item (WdTestSession multi)
-> Params
-> (ActionWith (WdTestSession multi) -> IO ())
-> ProgressCallback
-> IO Result
forall a.
Item a
-> Params
-> (ActionWith a -> IO ())
-> ProgressCallback
-> IO Result
itemExample Item (WdTestSession multi)
item Params
p (ActionWith () -> IO ()
act (ActionWith () -> IO ())
-> (ActionWith (WdTestSession multi) -> ActionWith ())
-> ActionWith (WdTestSession multi)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActionWith (WdTestSession multi) -> ActionWith ()
act') ProgressCallback
progress }
    where
        act' :: ActionWith (WdTestSession multi) -> ActionWith ()
act' ActionWith (WdTestSession multi)
f () = ActionWith (WdTestSession multi)
f (WDConfig
-> [MVar (SessionState multi)] -> Int -> WdTestSession multi
forall multi.
WDConfig
-> [MVar (SessionState multi)] -> Int -> WdTestSession multi
createTestSession WDConfig
cfg [MVar (SessionState multi)]
mvars Int
n)

-- | Convert a spec tree of test items to a spec tree of generic items by creating a single session for
-- the entire tree.
procTestSession :: W.WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession :: WDConfig -> Capabilities -> SpecWith (WdTestSession multi) -> Spec
procTestSession WDConfig
cfg Capabilities
cap SpecWith (WdTestSession multi)
s = do
    ([MVar (SessionState multi)]
mvars, [SpecTree (WdTestSession multi)]
trees) <- IO ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
-> SpecM
     () ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
forall r a. IO r -> SpecM a r
runIO (IO ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
 -> SpecM
      () ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)]))
-> IO
     ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
-> SpecM
     () ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
forall a b. (a -> b) -> a -> b
$ do
        [SpecTree (WdTestSession multi)]
trees <- SpecWith (WdTestSession multi)
-> IO [SpecTree (WdTestSession multi)]
forall a. SpecWith a -> IO [SpecTree a]
runSpecM SpecWith (WdTestSession multi)
s
        let cnt :: Int
cnt = [SpecTree (WdTestSession multi)] -> Int
forall a. [SpecTree a] -> Int
countItems [SpecTree (WdTestSession multi)]
trees
        [MVar (SessionState multi)]
mvars <- Int
-> IO (MVar (SessionState multi)) -> IO [MVar (SessionState multi)]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
cnt IO (MVar (SessionState multi))
forall a. IO (MVar a)
newEmptyMVar
        ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
-> IO
     ([MVar (SessionState multi)], [SpecTree (WdTestSession multi)])
forall (m :: * -> *) a. Monad m => a -> m a
return ([MVar (SessionState multi)]
mvars, [SpecTree (WdTestSession multi)]
trees)

    [SpecTree ()] -> Spec
forall a. [SpecTree a] -> SpecWith a
fromSpecList ([SpecTree ()] -> Spec) -> [SpecTree ()] -> Spec
forall a b. (a -> b) -> a -> b
$ (Int -> Item (WdTestSession multi) -> Item ())
-> [SpecTree (WdTestSession multi)] -> [SpecTree ()]
forall a b.
(Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter (WDConfig
-> [MVar (SessionState multi)]
-> Int
-> Item (WdTestSession multi)
-> Item ()
forall multi.
WDConfig
-> [MVar (SessionState multi)]
-> Int
-> Item (WdTestSession multi)
-> Item ()
procSpecItem WDConfig
cfg {wdCapabilities :: Capabilities
W.wdCapabilities = Capabilities
cap} [MVar (SessionState multi)]
mvars) [SpecTree (WdTestSession multi)]
trees

instance Eq multi => Example (WdExample multi) where
    type Arg (WdExample multi) = WdTestSession multi
    evaluateExample :: WdExample multi
-> Params
-> (ActionWith (Arg (WdExample multi)) -> IO ())
-> ProgressCallback
-> IO Result
evaluateExample (WdPending Maybe String
msg) Params
_ ActionWith (Arg (WdExample multi)) -> IO ()
_ ProgressCallback
_ = Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> ResultStatus -> Result
Result String
"" (Maybe Location -> Maybe String -> ResultStatus
Pending Maybe Location
forall a. Maybe a
Nothing Maybe String
msg)
    evaluateExample (WdExample multi
multi (WdOptions {Bool
skipRemainingTestsAfterFailure :: Bool
skipRemainingTestsAfterFailure :: WdOptions -> Bool
skipRemainingTestsAfterFailure}) WD ()
wd) Params
_ ActionWith (Arg (WdExample multi)) -> IO ()
act ProgressCallback
_ = do
        IORef Bool
prevHadError <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False
        IORef Bool
aborted <- Bool -> IO (IORef Bool)
forall a. a -> IO (IORef a)
newIORef Bool
False

        ActionWith (Arg (WdExample multi)) -> IO ()
act (ActionWith (Arg (WdExample multi)) -> IO ())
-> ActionWith (Arg (WdExample multi)) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Arg (WdExample multi)
testsession -> do

            SessionState multi
tstate <- WdTestSession multi -> IO (SessionState multi)
forall multi. WdTestSession multi -> IO (SessionState multi)
wdTestOpen Arg (WdExample multi)
WdTestSession multi
testsession

            Maybe WDSession
msess <- case (multi -> [(multi, WDSession)] -> Maybe WDSession
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup multi
multi ([(multi, WDSession)] -> Maybe WDSession)
-> [(multi, WDSession)] -> Maybe WDSession
forall a b. (a -> b) -> a -> b
$ SessionState multi -> [(multi, WDSession)]
forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
tstate,
                           (SessionState multi -> Bool
forall multi. SessionState multi -> Bool
stPrevHadError SessionState multi
tstate Bool -> Bool -> Bool
|| SessionState multi -> Bool
forall multi. SessionState multi -> Bool
stPrevAborted SessionState multi
tstate) Bool -> Bool -> Bool
&& Bool
skipRemainingTestsAfterFailure) of
                (Maybe WDSession
_, Bool
True) -> Maybe WDSession -> IO (Maybe WDSession)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe WDSession
forall a. Maybe a
Nothing
                (Just WDSession
s, Bool
False) -> Maybe WDSession -> IO (Maybe WDSession)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe WDSession -> IO (Maybe WDSession))
-> Maybe WDSession -> IO (Maybe WDSession)
forall a b. (a -> b) -> a -> b
$ WDSession -> Maybe WDSession
forall a. a -> Maybe a
Just WDSession
s
                (Maybe WDSession
Nothing, Bool
False) ->
                    WDSession -> Maybe WDSession
forall a. a -> Maybe a
Just (WDSession -> Maybe WDSession)
-> IO WDSession -> IO (Maybe WDSession)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SessionState multi -> IO WDSession
forall multi. SessionState multi -> IO WDSession
stCreateSession SessionState multi
tstate
                        IO WDSession -> IO () -> IO WDSession
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
m a -> m b -> m a
`onException` WdTestSession multi -> SessionState multi -> IO ()
forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
WdTestSession multi
testsession SessionState multi
tstate { stPrevHadError :: Bool
stPrevHadError = Bool
True }

            case Maybe WDSession
msess of
                Just WDSession
wdsession -> WDSession -> WD () -> IO ()
forall a. WDSession -> WD a -> IO a
W.runWD WDSession
wdsession (WD () -> IO ()) -> WD () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    -- run the example
                    Either SomeException ()
macterr <- WD () -> WD (Either SomeException ())
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> m (Either e a)
try WD ()
wd
                    case Either SomeException ()
macterr of
                        Right () -> do
                            -- pass current session on to the next test
                            WDSession
wdsession' <- WD WDSession
forall (m :: * -> *). WDSessionState m => m WDSession
W.getSession
                            let smap :: [(multi, WDSession)]
smap = (multi
multi, WDSession
wdsession') (multi, WDSession) -> [(multi, WDSession)] -> [(multi, WDSession)]
forall a. a -> [a] -> [a]
: ((multi, WDSession) -> Bool)
-> [(multi, WDSession)] -> [(multi, WDSession)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((multi -> multi -> Bool
forall a. Eq a => a -> a -> Bool
/=multi
multi) (multi -> Bool)
-> ((multi, WDSession) -> multi) -> (multi, WDSession) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (multi, WDSession) -> multi
forall a b. (a, b) -> a
fst) (SessionState multi -> [(multi, WDSession)]
forall multi. SessionState multi -> [(multi, WDSession)]
stSessionMap SessionState multi
tstate)
                            IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ WdTestSession multi -> SessionState multi -> IO ()
forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
WdTestSession multi
testsession SessionState multi
tstate { stSessionMap :: [(multi, WDSession)]
stSessionMap = [(multi, WDSession)]
smap }

                        Left acterr :: SomeException
acterr@(SomeException e
actex) ->
                            case e -> Maybe AbortSession
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
actex of
                                Just AbortSession
AbortSession -> do
                                    -- pass empty list on to the next test so the session is not closed
                                    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ WdTestSession multi -> SessionState multi -> IO ()
forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
WdTestSession multi
testsession SessionState multi
tstate { stSessionMap :: [(multi, WDSession)]
stSessionMap = [], stPrevAborted :: Bool
stPrevAborted = Bool
True }
                                    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
aborted Bool
True
                                Maybe AbortSession
Nothing -> do
                                    IO () -> WD ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> WD ()) -> IO () -> WD ()
forall a b. (a -> b) -> a -> b
$ WdTestSession multi -> SessionState multi -> IO ()
forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
WdTestSession multi
testsession SessionState multi
tstate { stPrevHadError :: Bool
stPrevHadError = Bool
True }
                                    SomeException -> WD ()
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
throwIO SomeException
acterr

                Maybe WDSession
_ -> do
                    -- on error, just pass along the session and error
                    IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
prevHadError (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionState multi -> Bool
forall multi. SessionState multi -> Bool
stPrevHadError SessionState multi
tstate
                    IORef Bool -> Bool -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Bool
aborted (Bool -> IO ()) -> Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ SessionState multi -> Bool
forall multi. SessionState multi -> Bool
stPrevAborted SessionState multi
tstate
                    WdTestSession multi -> SessionState multi -> IO ()
forall multi. WdTestSession multi -> SessionState multi -> IO ()
wdTestClose Arg (WdExample multi)
WdTestSession multi
testsession SessionState multi
tstate

        Bool
merr <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
prevHadError
        Bool
mabort <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef IORef Bool
aborted
        Result -> IO Result
forall (m :: * -> *) a. Monad m => a -> m a
return (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ case (Bool
merr, Bool
mabort) of
            (Bool
True, Bool
_) -> String -> ResultStatus -> Result
Result String
"" (Maybe Location -> Maybe String -> ResultStatus
Pending Maybe Location
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"Previous example had an error"))
            (Bool
_, Bool
True) -> String -> ResultStatus -> Result
Result String
"" (Maybe Location -> Maybe String -> ResultStatus
Pending Maybe Location
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
"Session has been aborted"))
            (Bool, Bool)
_ -> String -> ResultStatus -> Result
Result String
"" ResultStatus
Success

--------------------------------------------------------------------------------
--- Utils
--------------------------------------------------------------------------------

-- | Traverse a spec allowing the type to change
traverseTree :: Applicative f => (Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree :: (Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree Item a -> f (Item b)
f (Leaf Item a
i) = Item b -> SpecTree b
forall c a. a -> Tree c a
Leaf (Item b -> SpecTree b) -> f (Item b) -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Item a -> f (Item b)
f Item a
i
traverseTree Item a -> f (Item b)
f (Node String
msg [SpecTree a]
ss) = String -> [SpecTree b] -> SpecTree b
forall c a. String -> [Tree c a] -> Tree c a
Node String
msg ([SpecTree b] -> SpecTree b) -> f [SpecTree b] -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecTree a -> f (SpecTree b)) -> [SpecTree a] -> f [SpecTree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree Item a -> f (Item b)
f) [SpecTree a]
ss
traverseTree Item a -> f (Item b)
f (NodeWithCleanup ActionWith a
c [SpecTree a]
ss) = (b -> IO ()) -> [SpecTree b] -> SpecTree b
forall c a. c -> [Tree c a] -> Tree c a
NodeWithCleanup b -> IO ()
c' ([SpecTree b] -> SpecTree b) -> f [SpecTree b] -> f (SpecTree b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SpecTree a -> f (SpecTree b)) -> [SpecTree a] -> f [SpecTree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree Item a -> f (Item b)
f) [SpecTree a]
ss
    where
        c' :: b -> IO ()
c' b
_b = ActionWith a
c a
forall a. HasCallStack => a
undefined -- this undefined is OK since we do not export the definition of WdTestSession
                            -- so the user cannot do anything with the passed in value to 'afterAll'

traverseSpec :: Applicative f => (Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec :: (Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec Item a -> f (Item b)
f = (SpecTree a -> f (SpecTree b)) -> [SpecTree a] -> f [SpecTree b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> SpecTree a -> f (SpecTree b)
traverseTree Item a -> f (Item b)
f)

-- | Process the items in a depth-first walk, passing in the item counter value.
mapWithCounter :: (Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter :: (Int -> Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
mapWithCounter Int -> Item a -> Item b
f [SpecTree a]
s = (State Int [SpecTree b] -> Int -> [SpecTree b])
-> Int -> State Int [SpecTree b] -> [SpecTree b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [SpecTree b] -> Int -> [SpecTree b]
forall s a. State s a -> s -> a
evalState Int
0 (State Int [SpecTree b] -> [SpecTree b])
-> State Int [SpecTree b] -> [SpecTree b]
forall a b. (a -> b) -> a -> b
$ (Item a -> StateT Int Identity (Item b))
-> [SpecTree a] -> State Int [SpecTree b]
forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec Item a -> StateT Int Identity (Item b)
go [SpecTree a]
s
    where
        go :: Item a -> StateT Int Identity (Item b)
go Item a
item = (Int -> (Item b, Int)) -> StateT Int Identity (Item b)
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((Int -> (Item b, Int)) -> StateT Int Identity (Item b))
-> (Int -> (Item b, Int)) -> StateT Int Identity (Item b)
forall a b. (a -> b) -> a -> b
$ \Int
cnt -> (Int -> Item a -> Item b
f Int
cnt Item a
item, Int
cntInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

countItems :: [SpecTree a] -> Int
countItems :: [SpecTree a] -> Int
countItems [SpecTree a]
s = (State Int [SpecTree a] -> Int -> Int)
-> Int -> State Int [SpecTree a] -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip State Int [SpecTree a] -> Int -> Int
forall s a. State s a -> s -> s
execState Int
0 (State Int [SpecTree a] -> Int) -> State Int [SpecTree a] -> Int
forall a b. (a -> b) -> a -> b
$ (Item a -> StateT Int Identity (Item a))
-> [SpecTree a] -> State Int [SpecTree a]
forall (f :: * -> *) a b.
Applicative f =>
(Item a -> f (Item b)) -> [SpecTree a] -> f [SpecTree b]
traverseSpec Item a -> StateT Int Identity (Item a)
forall (m :: * -> *) a a. (Monad m, Num a) => a -> StateT a m a
go [SpecTree a]
s
    where
        go :: a -> StateT a m a
go a
item = (a -> (a, a)) -> StateT a m a
forall (m :: * -> *) s a. Monad m => (s -> (a, s)) -> StateT s m a
state ((a -> (a, a)) -> StateT a m a) -> (a -> (a, a)) -> StateT a m a
forall a b. (a -> b) -> a -> b
$ \a
cnt -> (a
item, a
cnta -> a -> a
forall a. Num a => a -> a -> a
+a
1)