webdriver 0.5.2 → 0.5.3

raw patch · 6 files changed

+58/−44 lines, 6 filesdep ~aesondep ~attoparsec

Dependency ranges changed: aeson, attoparsec

Files

• CHANGELOG.md +10/−0
• TODO +0/−2
• src/Test/WebDriver/Commands.hs +9/−6
• src/Test/WebDriver/Commands/Wait.hs +34/−33
• src/Test/WebDriver/Internal.hs +2/−0
• webdriver.cabal +3/−3

@@ -1,5 +1,15 @@ #Change Log +##0.5.3++###new features+* SessionNotCreated constructor added to FailedCommandType+* new command deleteCookieByName added++###bug fixes+* asyncJS now properly distinguishes between a null return and a script timeout+* fixed a change in waitWhile causing the opposite of expected behavior+ ##0.5.2 ###API changes * added many new Internet Explorer capabilities

@@ -2,8 +2,6 @@  -- fix loadProfile so that it doesn't cause an overlap with user addExtension calls --- add support for new experimental IE capabilities- -- add support for Opera profiles  -- improve documentation

@@ -37,7 +37,7 @@        , focusFrame, FrameSelector(..)          -- * Cookies        , Cookie(..), mkCookie-       , cookies, setCookie, deleteCookie, deleteVisibleCookies+       , cookies, setCookie, deleteCookie, deleteVisibleCookies, deleteCookieByName          -- * Alerts        , getAlertText, replyToAlert, acceptAlert, dismissAlert          -- * Mouse gestures@@ -148,7 +148,7 @@ setScriptTimeout :: WebDriver wd => Integer -> wd () setScriptTimeout ms =   noReturn $ doSessCommand POST "/timeouts/async_script" (object msField)-    `L.catch` \(_ :: SomeException) ->+    `L.catch` \( _ :: SomeException) ->       doSessCommand POST "/timeouts" (object allFields)   where msField   = ["ms" .= ms]         allFields = ["type" .= ("script" :: String)] ++ msField@@ -217,11 +217,12 @@ Javascript function timed out (see 'setScriptTimeout') -} asyncJS :: (WebDriver wd, FromJSON a) => [JSArg] -> Text -> wd (Maybe a)-asyncJS a s = handle timeout $ fromJSON' =<< getResult+asyncJS a s = handle timeout $ Just <$> (fromJSON' =<< getResult)   where     getResult = doSessCommand POST "/execute_async" . pair ("args", "script")                 $ (a,s)-    timeout (FailedCommand Timeout _) = return Nothing+    timeout (FailedCommand Timeout _)       = return Nothing+    timeout (FailedCommand ScriptTimeout _) = return Nothing     timeout err = throwIO err  -- |Grab a screenshot of the current page as a PNG image@@ -365,8 +366,10 @@ -- |Delete a cookie. This will do nothing is the cookie isn't visible to the -- current page. deleteCookie :: WebDriver wd => Cookie -> wd ()-deleteCookie c = -  noReturn $ doSessCommand DELETE ("/cookie/" `append` urlEncode (cookName c)) Null+deleteCookie c = noReturn $ doSessCommand DELETE ("/cookie/" `append` urlEncode (cookName c)) Null++deleteCookieByName :: WebDriver wd => Text -> wd ()+deleteCookieByName n = noReturn $ doSessCommand DELETE ("/cookie/" `append` n) Null  -- |Delete all visible cookies on the current page. deleteVisibleCookies :: WebDriver wd => wd ()

@@ -61,16 +61,7 @@ -- |Similar to 'waitUntil' but allows you to also specify the poll frequency -- of the 'WD' action. The frequency is expressed as an integer in microseconds. waitUntil' :: SessionState m => Int -> Double -> m a -> m a-waitUntil' = wait' handler-  where-    handler retry = (`catches` [Handler handleFailedCommand-                               ,Handler handleExpectFailed]-                    )-      where-        handleFailedCommand e@(FailedCommand NoSuchElement _) = retry (show e)-        handleFailedCommand err = throwIO err--        handleExpectFailed (e :: ExpectFailed) = retry (show e)+waitUntil' = waitEither id (\_ -> return)  -- |Like 'waitUntil', but retries the action until it fails or until the timeout -- is exceeded.@@ -80,34 +71,44 @@ -- |Like 'waitUntil'', but retries the action until it either fails or -- until the timeout is exceeded. waitWhile' :: SessionState m => Int -> Double -> m a -> m ()-waitWhile' = wait' handler-  where-    handler retry wd = do-      b <- (wd >> return Nothing) `catches` [Handler handleFailedCommand-                                            ,Handler handleExpectFailed-                                            ]-      maybe (return ()) retry b-      where-        handleFailedCommand e@(FailedCommand NoSuchElement _) = return (Just $ show e)-        handleFailedCommand err = throwIO err+waitWhile' =+  waitEither  (\_ _ -> return ())+              (\retry _ -> retry "waitWhile: action did not fail") -        handleExpectFailed (e :: ExpectFailed) = return (Just $ show e) +-- |Internal function used to implement explicit wait commands using success and failure continuations+waitEither :: SessionState m =>+               ((String -> m b) -> String -> m b)+            -> ((String -> m b) -> a -> m b)+            -> Int -> Double -> m a -> m b+waitEither failure success = wait' handler+ where+  handler retry wd = do+    e <- fmap Right wd  `catches` [Handler handleFailedCommand+                                  ,Handler handleExpectFailed+                                  ]+    either (failure retry) (success retry) e+   where+    handleFailedCommand e@(FailedCommand NoSuchElement _) = return . Left . show $ e+    handleFailedCommand err = throwIO err++    handleExpectFailed (e :: ExpectFailed) = return . Left . show $ e+ wait' :: SessionState m =>          ((String -> m b) -> m a -> m b) -> Int -> Double -> m a -> m b wait' handler waitAmnt t wd = waitLoop =<< liftBase getCurrentTime-  where timeout = realToFrac t-        waitLoop startTime = handler retry wd-          where-            retry why = do-              now <- liftBase getCurrentTime-              if diffUTCTime now startTime >= timeout-                then-                  failedCommand Timeout $-                    "wait': explicit wait timed out (" ++ why ++ ")."-                else do-                  liftBase . threadDelay $ waitAmnt-                  waitLoop startTime+  where +    timeout = realToFrac t+    waitLoop startTime = handler retry wd+      where+        retry why = do+          now <- liftBase getCurrentTime+          if diffUTCTime now startTime >= timeout +            then +              failedCommand Timeout $ "wait': explicit wait timed out (" ++ why ++ ")."+            else do+              liftBase . threadDelay $ waitAmnt+              waitLoop startTime  -- |Convenience function to catch 'FailedCommand' 'Timeout' exceptions -- and perform some action.

@@ -159,6 +159,7 @@     30  -> e IMENotAvailable     31  -> e IMEEngineActivationFailed     32  -> e InvalidSelector+    33  -> e SessionNotCreated     34  -> e MoveTargetOutOfBounds     51  -> e InvalidXPathSelector     52  -> e InvalidXPathSelectorReturnType@@ -233,6 +234,7 @@                        | IMENotAvailable                        | IMEEngineActivationFailed                        | InvalidSelector+                       | SessionNotCreated                        | MoveTargetOutOfBounds                        | InvalidXPathSelector                        | InvalidXPathSelectorReturnType

@@ -1,5 +1,5 @@ Name: webdriver-Version: 0.5.2+Version: 0.5.3 Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE@@ -30,7 +30,7 @@   hs-source-dirs: src   ghc-options: -Wall   build-depends:   base == 4.*-                 , aeson >= 0.6.2.0 && < 0.7+                 , aeson >= 0.6.2.0 && < 0.8                  , HTTP >= 4000.1 && < 4000.3                  , mtl >= 2.0 && < 2.2                  , network == 2.4.*@@ -42,7 +42,7 @@                  , directory == 1.*                  , filepath == 1.*                  , unordered-containers >= 0.1.3 && < 0.4-                 , attoparsec == 0.10.*+                 , attoparsec < 0.12                  , monad-control == 0.3.*                  , transformers-base >= 0.1 && < 1.0                  , vector >= 0.3 && < 0.11