webdriver 0.3.2.1 → 0.3.3
raw patch · 8 files changed
+130/−69 lines, 8 filesdep +MonadCatchIO-transformers
Dependencies added: MonadCatchIO-transformers
Files
- CHANGELOG.md +16/−0
- TODO +9/−6
- src/Test/WebDriver/Classes.hs +1/−1
- src/Test/WebDriver/Commands/Wait.hs +21/−6
- src/Test/WebDriver/Common/Profile.hs +48/−33
- src/Test/WebDriver/Firefox/Profile.hs +31/−21
- src/Test/WebDriver/Monad.hs +2/−1
- webdriver.cabal +2/−1
CHANGELOG.md view
@@ -1,5 +1,21 @@ # Change Log +## hs-webdriver 0.3.3++###bug fixes+*The default preferences used by Selenium are now merged into the preferences of Firefox profiles loaded from disk.+*addExtension will now correctly add extension directories to a profile.++###API changes+* The representation of profile files has been changed to use a HashMap instead of an association list. This ensures that destination paths are always unique.++###new features +*It's now possible to add entire directories to a profile in pure code using addFile and addExtension.+*new functions in Common.Profile: unionProfiles, onProfileFiles, onProfilePrefs+*new function in Commands.Wait: onTimeout+*the WD monad now has a MonadCatchIO instance, as an alternative to lifted-base for exception handling++ ## hs-webdriver 0.3.2.1 ###bug fixes
TODO view
@@ -1,5 +1,11 @@-for next release+in upcoming releases +-- 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. Document errors. -- provide examples -- basic runSession usage@@ -9,24 +15,21 @@ -- firefox profile usage -- REPL usage + for 1.0 -- add WDSettings, use WDSession as internal State type. -- allow settings to automatically load drivers. add modules with driver loading functions--- allow setting to modify HTTP headers+-- use http-conduit and attoparsec-conduit to stream JSON data. use request methods from http-types distant future --- use http-conduit and attoparsec-conduit to stream JSON data. use request methods from http-types- -- use ReaderT to store WDVersion for use with implicit configurations. misc. unsorted --Use lazy ByteString where possible. patch base64-bytestring to work with lazy bytestrings---- add support for new experimental IE capabilities
src/Test/WebDriver/Classes.hs view
@@ -25,8 +25,8 @@ import Data.Typeable import Control.Monad.Trans.Maybe-import Control.Monad.List import Control.Monad.Trans.Identity+import Control.Monad.List import Control.Monad.Reader import Control.Monad.Error --import Control.Monad.Cont
src/Test/WebDriver/Commands/Wait.hs view
@@ -6,6 +6,7 @@ -- * Expected conditions , ExpectFailed, expect, unexpected -- ** Convenience functions+ , onTimeout , expectAny, expectAll , ifM, (<||>), (<&&>), notM ) where@@ -37,19 +38,20 @@ | b = return () | otherwise = unexpected --- |Apply a predicate to every element in a list, and expect that at least one--- succeeds.+-- |Apply a monadic predicate to every element in a list, and 'expect' that +-- at least one succeeds. expectAny :: MonadBaseControl IO m => (a -> m Bool) -> [a] -> m () expectAny p xs = expect . or =<< mapM p xs --- |Apply a predicate to every element in a list, and expect that all succeed.+-- |Apply a monadic predicate to every element in a list, and 'expect' that all +-- succeed. expectAll :: MonadBaseControl IO m => (a -> m Bool) -> [a] -> m () expectAll p xs = expect . and =<< mapM p xs -- |Wait until either the given action succeeds or the timeout is reached. -- The action will be retried every .25 seconds until no 'ExpectFailed' or--- 'Test.WebDriver.NoSuchElement' exceptions occur. If the timeout is reached, --- then a 'Test.WebDriver.Timeout' exception will be raised. The timeout value +-- 'FailedCommand' 'NoSuchElement' exceptions occur. If the timeout is reached, +-- then a 'Timeout' exception will be raised. The timeout value -- is expressed in seconds. waitUntil :: SessionState m => Double -> m a -> m a waitUntil = waitUntil' 500000@@ -100,6 +102,19 @@ if diffUTCTime now startTime >= timeout then failedCommand Timeout "wait': explicit wait timed out."- else do+ else do liftBase . threadDelay $ waitAmnt waitLoop startTime++-- |Convenience function to catch 'FailedCommand' 'Timeout' exceptions +-- and perform some action.+--+-- Example:+--+-- > waitUntil 5 (getText <=< findElem $ ByCSS ".class")+-- > `onTimeout` return ""+onTimeout :: MonadBaseControl IO m => m a -> m a -> m a+onTimeout m r = m `catch` handler+ where+ handler (FailedCommand Timeout _) = r+ handler other = throwIO other
src/Test/WebDriver/Common/Profile.hs view
@@ -10,8 +10,10 @@ , getPref, addPref, deletePref -- * Extensions , addExtension, deleteExtension, hasExtension- -- * Other files+ -- * Other files and directories , addFile, deleteFile, hasFile+ -- * Miscellaneous profile operations+ , unionProfiles, onProfileFiles, onProfilePrefs -- *Preparing profiles from disk , prepareLoadedProfile_ -- *Preparing zipped profiles@@ -21,9 +23,13 @@ , ProfileParseError(..) ) where +import System.Directory+import System.FilePath hiding (addExtension, hasExtension)+import Codec.Archive.Zip import Data.Aeson import Data.Aeson.Types import Data.Attoparsec.Number (Number(..))+ import qualified Data.HashMap.Strict as HM import Data.Text (Text, pack) import Data.ByteString (ByteString)@@ -31,17 +37,11 @@ import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base64 as B64 -import Codec.Archive.Zip-import System.Directory-import System.FilePath hiding (addExtension, hasExtension) - import Data.Fixed import Data.Ratio import Data.Int import Data.Word-import Data.List-import Data.Maybe import Data.Typeable import Control.Exception@@ -50,14 +50,18 @@ -- |This structure allows you to construct and manipulate profiles in pure code, -- deferring execution of IO operations until the profile is \"prepared\". This --- type is shared by both Firefox and Opera profile code; when a distinction +-- type is shared by both Firefox and Opera profiles; when a distinction -- must be made, the phantom type parameter is used to differentiate. data Profile b = Profile - { -- |A set of filepaths pointing to files to place in- -- the extension directory. The first tuple element is the source - -- path. The second tuple element is the destination path - -- relative to the extension of the file.- profileFiles :: [(FilePath, FilePath)]+ { -- |A mapping from relative destination filepaths to source+ -- filepaths found on the filesystem. When the profile is + -- prepared, these source filepaths will be moved to their+ -- destinations within the profile directory.+ --+ -- Using the destination path as the key ensures that + -- there is one unique source path going to each+ -- destination path.+ profileFiles :: HM.HashMap FilePath FilePath -- |A map of Firefox preferences. These are the settings -- found in the profile's prefs.js, and entries found in -- about:config@@ -152,32 +156,32 @@ -- |Add a new preference entry to a profile, overwriting any existing entry -- with the same key. addPref :: ToPref a => Text -> a -> Profile b -> Profile b-addPref k v p = asMap p $ HM.insert k (toPref v)+addPref k v p = onProfilePrefs p $ HM.insert k (toPref v) -- |Delete an existing preference entry from a profile. This operation is -- silent if the preference wasn't found. deletePref :: Text -> Profile b -> Profile b-deletePref k p = asMap p $ HM.delete k+deletePref k p = onProfilePrefs p $ HM.delete k -- |Add a file to the profile directory. The first argument is the source -- of the file on the local filesystem. The second argument is the destination --- as a path relative to a profile directory. +-- as a path relative to a profile directory. Overwrites any file that+-- previously pointed to the same destination addFile :: FilePath -> FilePath -> Profile b -> Profile b-addFile src dest p = asList p ((src, dest):)+addFile src dest p = onProfileFiles p $ HM.insert dest src -- |Delete a file from the profile directory. The first argument is the name of -- file within the profile directory. deleteFile :: FilePath -> Profile b -> Profile b-deleteFile path prof = asList prof $ filter (\(_,p) -> p == path)+deleteFile path prof = onProfileFiles prof $ HM.delete path --- |Determines if a profile contains the given file. specified as a path relative to--- the profile directory.+-- |Determines if a profile contains the given file, specified as a path+-- relative to the profile directory. hasFile :: String -> Profile b -> Bool-hasFile path (Profile files _) = isJust $ find (\(_,d) -> d == path) files+hasFile path (Profile files _) = path `HM.member` files -- |Add a new extension to the profile. The file path should refer to--- an .xpi file or an extension directory on the filesystem. If possible,--- you should avoiding adding the same extension twice to a given profile.+-- a .xpi file or an extension directory on the filesystem. addExtension :: FilePath -> Profile b -> Profile b addExtension path = addFile path ("extensions" </> name) where (_, name) = splitFileName path@@ -189,20 +193,31 @@ deleteExtension :: String -> Profile b -> Profile b deleteExtension name = deleteFile ("extensions" </> name) --- |Determines if a profile contains the given extension. specified as an .xpi file --- or directory name+-- |Determines if a profile contains the given extension. specified as an +-- .xpi file or directory name hasExtension :: String -> Profile b -> Bool hasExtension name prof = hasFile ("extensions" </> name) prof -asMap :: Profile b- -> (HM.HashMap Text ProfilePref -> HM.HashMap Text ProfilePref)- -> Profile b-asMap (Profile hs hm) f = Profile hs (f hm) -asList :: Profile b- -> ([(FilePath, FilePath)] -> [(FilePath, FilePath)])- -> Profile b-asList (Profile ls hm) f = Profile (f ls) hm+-- |Takes the union of two profiles. This is the union of their 'HashMap' +-- fields.+unionProfiles :: Profile b -> Profile b -> Profile b+unionProfiles (Profile f1 p1) (Profile f2 p2) + = Profile (f1 `HM.union` f2) (p1 `HM.union` p2)++-- |Modifies the 'profilePrefs' field of a profile.+onProfilePrefs :: Profile b+ -> (HM.HashMap Text ProfilePref + -> HM.HashMap Text ProfilePref)+ -> Profile b+onProfilePrefs (Profile hs hm) f = Profile hs (f hm)++-- |Modifies the 'profileFiles' field of a profile+onProfileFiles :: Profile b+ -> (HM.HashMap FilePath FilePath + -> HM.HashMap FilePath FilePath)+ -> Profile b+onProfileFiles (Profile ls hm) f = Profile (f ls) hm -- |Efficiently load an existing profile from disk and prepare it for network
src/Test/WebDriver/Firefox/Profile.hs view
@@ -13,8 +13,10 @@ , addPref, getPref, deletePref -- * Extensions , addExtension, deleteExtension, hasExtension- -- * Other Files+ -- * Other files and directories , addFile, removeFile, hasFile+ -- * Miscellaneous profile operations+ , unionProfiles, onProfileFiles, onProfilePrefs -- * Loading and preparing profiles , prepareProfile, prepareTempProfile -- ** Preparing profiles from disk@@ -41,17 +43,20 @@ import Control.Monad import Control.Monad.Base import Control.Monad.Trans.Control+import Control.Exception.Lifted hiding (try) import Control.Applicative+import Control.Arrow import Data.List-import Control.Exception.Lifted hiding (try)+ import Prelude hiding (catch) -- |Phantom type used in the parameters of 'Profile' and 'PreparedProfile' data Firefox +-- |Default Firefox Profile, used when no profile is supplied. defaultProfile :: Profile Firefox defaultProfile = - Profile []+ Profile HM.empty $ HM.fromList [("app.update.auto", PrefBool False) ,("app.update.enabled", PrefBool False) ,("browser.startup.page" , PrefInteger 0)@@ -116,24 +121,26 @@ -- |Load an existing profile from the file system. Any prepared changes made to -- the 'Profile' will have no effect to the profile on disk.+--+-- To make automated browser run smoothly, preferences found in+-- 'defaultProfile' are automatically merged into the preferences of the on-disk-- profile. The on-disk profile's preference will override those found in the +-- default profile. loadProfile :: MonadBaseControl IO m => FilePath -> m (Profile Firefox) loadProfile path = liftBase $ do- Profile <$> getFiles <*> getPrefs+ unionProfiles defaultProfile <$> (Profile <$> getFiles <*> getPrefs) where- getFiles = do- d <- FS.getDirectory' path- case FS.filter (not.isIgnored) [d] of- [d'] -> return $ FS.zipWithDest (,) "" d'- _ -> return []- where isIgnored p = "Cache/" `isInfixOf` p- || "OfflineCache/" `isInfixOf` p- || "lock" `isSuffixOf` p+ userPrefFile = path </> "prefs" <.> "js" - userPref = path </> "prefs" <.> "js"- getPrefs = HM.fromList <$> (parsePrefs =<< BS.readFile userPref)- parsePrefs s = either (throwIO . ProfileParseError)- return- $ parseOnly prefsParser s+ getFiles = HM.fromList . map (id &&& (path </>)) . filter isNotIgnored+ <$> getDirectoryContents path+ where isNotIgnored = (`notElem` + [".", "..", "OfflineCache", "Cache"+ ,"parent.lock", ".parentlock", ".lock"+ ,userPrefFile])+ + getPrefs = HM.fromList <$> (parsePrefs =<< BS.readFile userPrefFile)+ where parsePrefs s = either (throwIO . ProfileParseError) return + $ parseOnly prefsParser s -- |Prepare a firefox profile for network transmission. -- Internally, this function constructs a Firefox profile within a temp @@ -149,16 +156,19 @@ prepareProfile Profile {profileFiles = files, profilePrefs = prefs} = liftBase $ do tmpdir <- mkTemp- mapM_ (installPath tmpdir) files+ mapM_ (installPath tmpdir) . HM.toList $ files installUserPrefs tmpdir prepareLoadedProfile_ tmpdir- <* removeDirectoryRecursive tmpdir+-- <* removeDirectoryRecursive tmpdir where- installPath destDir (src, destPath) = do+ installPath destDir (destPath, src) = do let dest = destDir </> destPath isDir <- doesDirectoryExist src if isDir- then createDirectoryIfMissing True dest `catch` ignoreIOException+ then do+ createDirectoryIfMissing True dest `catch` ignoreIOException+ FS.getDirectory src + >>= handle ignoreIOException . FS.copyTo_ dest else do let dir = takeDirectory dest when (not . null $ dir) $
src/Test/WebDriver/Monad.hs view
@@ -16,13 +16,14 @@ import Control.Monad.State.Strict (StateT, MonadState, evalStateT, get, put) import Control.Monad.IO.Class (MonadIO) import Control.Exception.Lifted+import Control.Monad.CatchIO (MonadCatchIO) import Control.Applicative {- |A monadic interface to the WebDriver server. This monad is a simple, strict layer over 'IO', threading session information between sequential commands -} newtype WD a = WD (StateT WDSession IO a)- deriving (Functor, Monad, MonadIO, Applicative)+ deriving (Functor, Applicative, Monad, MonadIO, MonadCatchIO) instance MonadBase IO WD where liftBase = WD . liftBase
webdriver.cabal view
@@ -1,5 +1,5 @@ Name: webdriver-Version: 0.3.2.1+Version: 0.3.3 Cabal-Version: >= 1.6 License: BSD3 License-File: LICENSE@@ -47,6 +47,7 @@ , transformers-base < 1.0 , vector >= 0.3 , lifted-base == 0.1.*+ , MonadCatchIO-transformers >= 0.3 && < 0.4 , filesystem-trees >= 0.1.0.2 && < 0.2 , data-default , temporary