packages feed

webdriver 0.5.3.1 → 0.5.3.2

raw patch · 9 files changed

+60/−29 lines, 9 filesdep +directory-treedep +scientificdep −filesystem-trees

Dependencies added: directory-tree, scientific

Dependencies removed: filesystem-trees

Files

CHANGELOG.md view
@@ -1,5 +1,10 @@ #Change Log +##0.5.3.2+###bug fixes+* fixed remaining compilation problems with aeson. now supports aeson >= 0.6.2.0 && < 0.8+* now depends on directory-tree instead of filesystem-trees. this fixes several problems with firefox/chrome profile support.+ ##0.5.3.1 ###bug fixes * fixed compilation error with aeson 0.7 and greater
src/Test/WebDriver/Capabilities.hs view
src/Test/WebDriver/Commands.hs view
@@ -89,6 +89,7 @@ import Data.ByteString.Lazy as LBS (ByteString) import Network.URI hiding (path)  -- suppresses warnings import Codec.Archive.Zip+import qualified Data.Text.Lazy.Encoding as TL  import Control.Applicative import Control.Monad.State.Strict@@ -231,7 +232,7 @@  -- |Grab a screenshot as a base-64 encoded PNG image. This is the protocol-defined format. screenshotBase64 :: WebDriver wd => wd LBS.ByteString-screenshotBase64 = doSessCommand GET "/screenshot" Null+screenshotBase64 = TL.encodeUtf8 <$> doSessCommand GET "/screenshot" Null  availableIMEEngines :: WebDriver wd => wd [Text] availableIMEEngines = doSessCommand GET "/ime/available_engines" Null@@ -695,7 +696,7 @@ -- the zip entry sent across network. uploadZipEntry :: WebDriver wd => Entry -> wd () uploadZipEntry = noReturn . doSessCommand POST "/file" . single "file"-                 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive)+                 . TL.decodeUtf8 . B64.encode . fromArchive . (`addEntryToArchive` emptyArchive)   -- |Get the current number of keys in a web storage area.
src/Test/WebDriver/Commands/Wait.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts #-}+{-# LANGUAGE CPP, DeriveDataTypeable, ScopedTypeVariables, FlexibleContexts #-} module Test.WebDriver.Commands.Wait        ( -- * Wait on expected conditions          waitUntil, waitUntil'@@ -12,7 +12,6 @@        ) where import Test.WebDriver.Exceptions import Test.WebDriver.Classes-import Control.Monad import Control.Monad.Base import Control.Monad.Trans.Control import Control.Exception.Lifted@@ -20,7 +19,10 @@ import Data.Time.Clock import Data.Typeable import Control.Conditional (ifM, (<||>), (<&&>), notM)++#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding (catch)+#endif  instance Exception ExpectFailed -- |An exception representing the failure of an expected condition.
src/Test/WebDriver/Common/Profile.hs view
@@ -28,7 +28,12 @@ import Codec.Archive.Zip import Data.Aeson import Data.Aeson.Types++#if MIN_VERSION_aeson(0,7,0)+import Data.Scientific+#else import Data.Attoparsec.Number (Number(..))+#endif  import qualified Data.HashMap.Strict as HM import Data.Text (Text, pack)@@ -36,6 +41,7 @@ --import qualified Data.ByteString as SBS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.Text.Lazy.Encoding as TL   import Data.Fixed@@ -75,10 +81,10 @@   deriving (Eq, Show)  instance FromJSON (PreparedProfile s) where-  parseJSON v = PreparedProfile <$> parseJSON v+  parseJSON v = PreparedProfile . TL.encodeUtf8 <$> parseJSON v  instance ToJSON (PreparedProfile s) where-  toJSON (PreparedProfile s) = toJSON s+  toJSON (PreparedProfile s) = toJSON $ TL.decodeUtf8 s  -- |A profile preference value. This is the subset of JSON values that excludes -- arrays, objects, and null.@@ -98,8 +104,13 @@ instance FromJSON ProfilePref where   parseJSON (String s) = return $ PrefString s   parseJSON (Bool b) = return $ PrefBool b+#if MIN_VERSION_aeson(0,7,0)+  parseJSON (Number s) | base10Exponent s >= 0 = return $ PrefInteger (coefficient s * 10^(base10Exponent s))+                       | otherwise = return $ PrefDouble $ realToFrac s+#else   parseJSON (Number (I i)) = return $ PrefInteger i   parseJSON (Number (D d)) = return $ PrefDouble d+#endif   parseJSON other = typeMismatch "ProfilePref" other  instance Exception ProfileParseError
src/Test/WebDriver/Firefox/Profile.hs view
@@ -38,7 +38,7 @@ import System.FilePath hiding (addExtension, hasExtension) import System.Directory import System.IO.Temp (createTempDirectory)-import qualified System.File.Tree as FS+import qualified System.Directory.Tree as DS  import Control.Monad import Control.Monad.Base@@ -46,9 +46,10 @@ import Control.Exception.Lifted hiding (try) import Control.Applicative import Control.Arrow-import Data.List +#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706 import Prelude hiding (catch)+#endif  -- |Phantom type used in the parameters of 'Profile' and 'PreparedProfile' data Firefox@@ -167,8 +168,9 @@       if isDir         then do           createDirectoryIfMissing True dest `catch` ignoreIOException-          FS.getDirectory src-            >>= handle ignoreIOException . FS.copyTo_ dest+          (_ DS.:/ dir) <- DS.readDirectoryWithL LBS.readFile src+          handle ignoreIOException . void+              $ DS.writeDirectoryWith LBS.writeFile (dest DS.:/ dir)         else do           let dir = takeDirectory dest           when (not . null $ dir) $
src/Test/WebDriver/Internal.hs view
@@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleContexts, OverloadedStrings, DeriveDataTypeable #-} module Test.WebDriver.Internal-       ( mkWDUri, mkRequest+       ( mkWDUri, mkRequest, sendHTTPRequest        , handleHTTPErr, handleJSONErr, handleHTTPResp        , WDResponse(..) @@ -24,6 +24,7 @@ import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 as LBS (length, unpack, null) import qualified Data.ByteString.Base64.Lazy as B64+import qualified Data.Text.Lazy.Encoding as TL  import Control.Monad.Base import Control.Exception.Lifted (throwIO)@@ -36,6 +37,7 @@ import Data.String (fromString) import Data.Word (Word, Word8) +-- |Take a URL path and construct a full URL using the current session state mkWDUri :: (SessionState s) => String -> s URI mkWDUri wdPath = do    WDSession{wdHost = host, @@ -51,24 +53,30 @@     (_, Nothing) -> throwIO $ InvalidURL relPath     (Just baseURI, Just relURI) -> return $ relURI `relativeTo` baseURI +-- |Constructs a 'Request' value when given a list of headers, HTTP request method, and URL path mkRequest :: (SessionState s, ToJSON a) =>-             [Header] -> RequestMethod -> Text -> a -> s (Response ByteString)+             [Header] -> RequestMethod -> Text -> a -> s (Request ByteString) mkRequest headers method wdPath args = do   uri <- mkWDUri (T.unpack wdPath)   let body = case toJSON args of         Null  -> ""   --passing Null as the argument indicates no request body         other -> encode other-      req = Request { rqURI = uri             --todo: normalization of headers-                    , rqMethod = method-                    , rqBody = body-                    , rqHeaders = headers ++ [ Header HdrAccept-                                               "application/json;charset=UTF-8"-                                             , Header HdrContentType-                                               "application/json;charset=UTF-8"-                                             , Header HdrContentLength-                                               . show . LBS.length $ body-                                             ]-                    }+  return Request { rqURI = uri             --todo: normalization of headers+                 , rqMethod = method+                 , rqBody = body+                 , rqHeaders = headers ++ [ Header HdrAccept+                                            "application/json;charset=UTF-8"+                                          , Header HdrContentType+                                            "application/json;charset=UTF-8"+                                          , Header HdrContentLength+                                            . show . LBS.length $ body+                                          ]+                 }++++sendHTTPRequest :: SessionState s => Request ByteString -> s (Response ByteString) +sendHTTPRequest req = do   r <- liftBase (simpleHTTP req) >>= either (throwIO . HTTPConnError) return   modifySession $ \s -> s {lastHTTPRequest = Just req} -- update lastHTTPRequest field   return r@@ -315,7 +323,7 @@   parseJSON (Object o) =     FailedCommandInfo <$> (req "message" >>= maybe (return "") return)                       <*> pure undefined-                      <*> opt "screen"     Nothing+                      <*> (fmap TL.encodeUtf8 <$> opt "screen" Nothing)                       <*> opt "class"      Nothing                       <*> opt "stackTrace" []     where req :: FromJSON a => Text -> Parser a
src/Test/WebDriver/Monad.hs view
@@ -43,9 +43,10 @@  instance WebDriver WD where   doCommand method path args = do-    r <- mkRequest [] method path args-    handleHTTPErr r-    handleHTTPResp r+    req <- mkRequest [] method path args+    res <- sendHTTPRequest req+    handleHTTPErr res+    handleHTTPResp res  -- |Executes a 'WD' computation within the 'IO' monad, using the given -- 'WDSession'.
webdriver.cabal view
@@ -1,5 +1,5 @@ Name: webdriver-Version: 0.5.3.1+Version: 0.5.3.2 Cabal-Version: >= 1.8 License: BSD3 License-File: LICENSE@@ -48,11 +48,12 @@                  , vector >= 0.3 && < 0.11                  , lifted-base >= 0.1 && < 0.3                  , MonadCatchIO-transformers >= 0.3 && < 0.4-                 , filesystem-trees >= 0.1.0.5 && < 0.2+                 , directory-tree == 0.11.*                  , data-default >= 0.2 && < 1.0                  , temporary >= 1.0 && < 2.0                  , base64-bytestring >= 1.0 && < 1.1                  , cond >= 0.3 && < 0.5+                 , scientific >= 0.2 && < 0.3    exposed-modules: Test.WebDriver                    Test.WebDriver.Classes