{-# LANGUAGE TemplateHaskell, OverloadedStrings, DeriveDataTypeable #-} -- | This module exposes actions that can -- be used to interact with a page which uses . This provides -- similar functionality as and in fact we share -- some code with protractor. module Test.WebDriver.Commands.Angular ( -- * Loading waitForAngular -- * Searching for elements , NgException(..) , NgSelector(..) , findNg , findNgs , findNgFrom , findNgsFrom , NgRepeater(..) , findRepeater , findRepeaters , findRepeaterFrom , findRepeatersFrom -- * Misc , ngEvaluate , getLocationAbsUrl ) where import Control.Applicative ((<$>)) import Control.Monad.IO.Class (liftIO, MonadIO) import Control.Exception (throwIO, Exception) import Data.Maybe (catMaybes) import Data.Monoid ((<>)) import Data.Typeable (Typeable) import Test.WebDriver.Classes import Test.WebDriver.Commands import Test.WebDriver.JSON (fromJSON') import Test.WebDriver.Commands.Internal (clientScripts) import Language.Haskell.TH (runIO, litE, stringL) import qualified Data.Aeson as A import qualified Data.HashMap.Lazy as M import qualified Data.Text as T -- | Map of the clientsidescripts for angular cs :: M.HashMap T.Text T.Text cs = either (\err -> error $ "Error parsing scripts " ++ err) id mhash where mhash = clientScripts j j = $(runIO (readFile "js/angular-clientsidescripts.js") >>= litE . stringL) execCS :: (WebDriver wd, A.FromJSON a) => T.Text -> [JSArg] -> wd a execCS script arg = executeJS arg body where body = maybe (error $ "Unable to find " ++ T.unpack script) id $ M.lookup script cs -- | Variant of execCS that fails properly on Null execElems :: WebDriver wd => T.Text -> [JSArg] -> wd [Element] execElems script arg = do x <- execCS script arg case (x, A.fromJSON x) of (A.Null, _) -> return [] (A.Array _, A.Success [A.Null]) -> return [] _ -> catMaybes <$> fromJSON' x -- parse as [Maybe Element] and drop the nothings because -- looking up ByRow returns Nulls in the list. {- asyncCS :: (WebDriver wd, A.FromJSON a) => T.Text -> [JSArg] -> wd (Maybe a) asyncCS script arg = asyncJS arg body where body = maybe (error $ "Unable to find " ++ T.unpack script) id $ M.lookup script cs -} -- | Wait until Angular has finished rendering before continuing. @False@ indicates the timeout -- was hit (see 'setScriptTimeout') and we stopped waiting and @True@ means that angular has -- finished rendering. waitForAngular :: (MonadIO wd, WebDriver wd) => T.Text -- ^ CSS selector to element which has ng-app -> wd Bool waitForAngular sel = do --a <- asyncCS "waitForAngular" [JSArg sel] :: WebDriver wd => wd (Maybe let body = maybe (error $ "Unable to find waitForAngular") id $ M.lookup "waitForAngular" cs body' = "var oldDone = arguments[1]; arguments[1] = function(e) { oldDone(e || true); };" <> body a <- asyncJS [JSArg sel] body' case a of Nothing -> return False Just (A.Bool True) -> return True Just _ -> liftIO $ throwIO $ NgException $ "Error waiting for angular: " ++ show a -- | Exceptions of this type will be thrown when an element is unable to be located. data NgException = NgException String deriving (Show, Eq, Typeable) instance Exception NgException checkOne :: (Show s, MonadIO wd, WebDriver wd) => s -> [Element] -> wd Element checkOne _ [e] = return e checkOne sel es = liftIO $ throwIO err where err = NgException $ "Selector " ++ show sel ++ " returned " ++ show es data NgSelector = ByBinding T.Text -- ^ Argument is the binding, e.g. {{dog.name}} | ByModel T.Text -- ^ Argument is the model name. Searches for elements with the @ng-model=\"name\"@ attribute. | BySelectedOption T.Text -- ^ Argument is a model name. Searches for selected options within a select element -- matching the modelname. That is, the @\@ elements within a -- @\