Here is my attempt at finding all inputs of type "text" on a webpage. I have since figured out I could use xpath, but I'd like to know how to make the way I attempted work. I'm most interested in how I would lifft my [Element] into the [WD Element] and make this program valid.
However if my approach is just wrong or unidiomatic, feel free to totally rewrite it. Here is the code:
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad
import Control.Monad.IO.Class
import Test.WebDriver
import Test.WebDriver.Classes (WebDriver (..))
import Test.WebDriver.Commands
import Test.WebDriver.Commands.Wait
main = do
runSession defaultSession capabilities $ do
openPage "http://www.appnitro.com/demo/view.php?id=1"
inputs <- findElems $ ByTag "input"
textElems <- filterM (liftM $ ((==) "text" . (`attr` "type"))) inputs
-- wait 20 seconds
waitUntil 20 (getText <=< findElem $ ByCSS ".doesnotexist")
`onTimeout` return ""
liftIO $ putStrLn "done"
where
capabilities = allCaps { browser=firefox }
-- [1 of 1] Compiling Main ( src/Main.hs, interpreted )
-- src/Main.hs:168:70:
-- Couldn't match type `Element' with `WD Element'
-- Expected type: [WD Element]
-- Actual type: [Element]
-- In the second argument of `filterM', namely `inputs'
-- In a stmt of a 'do' block:
-- textElems <- filterM
-- (liftM $ ((==) "text" . (`attr` "type"))) inputs
-- In the second argument of `($)', namely
-- `do { openPage "http://www.appnitro.com/demo/view.php?id=1";
-- inputs <- findElems $ ByTag "input";
-- textElems <- filterM
-- (liftM $ ((==) "text" . (`attr` "type"))) inputs;
-- waitUntil 20 (getText <=< findElem $ ByCSS ".doesnotexist")
-- `onTimeout` return "" }'
-- Failed, modules loaded: none.
This might not be the answer you were looking for, but I find it best to express these kinds of constraints on elements directly in the locators, in order not to clutter the haskell sources. As you mention using XPath is one possibility:
textElems <- findElems $ ByXPath "//input[#type='text']"
but I often prefer CSS selectors, which tend to be briefer (alas a bit less powerful - e.g. you cannot traverse from given element to its parent etc.) and work just as well in these simple cases
textElems <- findElems $ ByCSS "input[type='text']"
Replace your text elem filtering with this piece:
textElems <- filterM textElem inputs
And then add this where:
textElem e = (== Just "text") `fmap` (e `attr` "type")
But then you will still have the line with waitUntil that doesn't compile. That seems unrelated though as it has nothing to do with the filtering.
You have two errors in your code:
attr returns a Maybe value, thus you must compare with Just "text".
And given that attr already returns a value in the WD monad, you just have to lift just the first function (has you had it, you were lifting everything, including the attr function):
textElems <- filterM (liftM ((==) (Just "text")) . (`attr` "type")) inputs
Or alternatively, since WD is also a Functor (I actually find this easier to understand, you are applying a pure function inside the monad returned by attr):
textElems <- filterM (fmap ((==) (Just "text")) . (`attr` "type")) inputs
Related
I'm trying to write code in source -> transform -> sink style, for example:
let (|>) = flip ($)
repeat 1 |> take 5 |> sum |> print
But would like to do that using IO. I have this impression that my source can be an infinite list of IO actions, and each one gets evaluated once it is needed downstream. Something like this:
-- prints the number of lines entered before "quit" is entered
[getLine..] >>= takeWhile (/= "quit") >>= length >>= print
I think this is possible with the streaming libraries, but can it be done along the lines of what I'm proposing?
Using the repeatM, takeWhile and length_ functions from the streaming library:
import Streaming
import qualified Streaming.Prelude as S
count :: IO ()
count = do r <- S.length_ . S.takeWhile (/= "quit") . S.repeatM $ getLine
print r
This seems to be in that spirit:
let (|>) = flip ($)
let (.>) = flip (.)
getContents >>= lines .> takeWhile (/= "quit") .> length .> print
The issue here is that Monad is not the right abstraction for this, and attempting to do something like this results in a situation where referential transparency is broken.
Firstly, we can do a lazy IO read like so:
module Main where
import System.IO.Unsafe (unsafePerformIO)
import Control.Monad(forM_)
lazyIOSequence :: [IO a] -> IO [a]
lazyIOSequence = pure . go where
go :: [IO a] -> [a]
go (l:ls) = (unsafePerformIO l):(go ls)
main :: IO ()
main = do
l <- lazyIOSequence (repeat getLine)
forM_ l putStrLn
This when run will perform cat. It will read lines and output them. Everything works fine.
But consider changing the main function to this:
main :: IO ()
main = do
l <- lazyIOSequence (map (putStrLn . show) [1..])
putStrLn "Hello World"
This outputs Hello World only, as we didn't need to evaluate any of l. But now consider replacing the last line like the following:
main :: IO ()
main = do
x <- lazyIOSequence (map (putStrLn . show) [1..])
seq (head x) putStrLn "Hello World"
Same program, but the output is now:
1
Hello World
This is bad, we've changed the results of a program just by evaluating a value. This is not supposed to happen in Haskell, when you evaluate something it should just evaluate it, not change the outside world.
So if you restrict your IO actions to something like reading from a file nothing else is reading from, then you might be able to sensibly lazily evaluate things, because when you read from it in relation to all the other IO actions your program is taking doesn't matter. But you don't want to allow this for IO in general, because skipping actions or performing them in a different order can matter (and above, certainly does). Even in the reading a file lazily case, if something else in your program writes to the file, then whether you evaluate that list before or after the write action will affect the output of your program, which again, breaks referential transparency (because evaluation order shouldn't matter).
So for a restricted subset of IO actions, you can sensibly define Functor, Applicative and Monad on a stream type to work in a lazy way, but doing so in the IO Monad in general is a minefield and often just plain incorrect. Instead you want a specialised streaming type, and indeed Conduit defines Functor, Applicative and Monad on a lot of it's types so you can still use all your favourite functions.
With the LambdaCase I am able to filter out if a dir does not exist. However: if a user is prompted and hits enter (empty) I still get an exception.
I think Maybe or Either can help me here, but I have a hard time figuring out how to set this up.
{-# LANGUAGE LambdaCase #-}
import System.Directory
import System.IO
dirExist = do
a <- prompt "Directory:> "
doesDirectoryExist a >>= \case
True -> getDirContent a
_ -> putStrLn "Directory does not exist or invalid value specified."
getDirContent :: FilePath -> IO ()
getDirContent dir = do
result <- getDirectoryContents dir
mapM_ putStrLn $ result
prompt :: String -> IO String
prompt x = do
putStr x
a <- getLine
return a
The problem is that doesDirectoryExist "" returns True, but whatever is in your getDirContent function (which you'll need to post if you want a more detailed answer) doesn't work when passed "".
There's no need for Maybe or Either to fix it. Just wrap the block in an if construct, and put something like putStrLn "You must enter a directory name" in the else.
You can replace the line:
doesDirectoryExist a >>= \case
with:
((&&) <$> (pure $ not $ null a) <*> doesDirectoryExist a) >>= \case
This is called "applicative style" (in case you didn't know it ;-)); I am combining two IO operations that return a boolean using the AND (&&) operator.
The (pure $ not $ null a) expression checks that the string isn't empty, and uses "pure" to lift a pure operation into an IO (so we can combine it with doesDirectoryExist into an expression that checks for both conditions).
EDIT:
As Joseph noted, the above executes doesDirectoryExist whether it is needed or not; you usually want to avoid that (unless you somehow rely on its side effects); you can avoid it with bradrn's suggestion; you can also do this:
(if null a then pure False else doesDirectoryExist a) >>= \case
Alternatively, since you dislike if-then-else notation (as do I):
(case null a of True -> pure False; False -> doesDirectoryExist a) >>= \case
Not really cleaner, though; you can import Data.Bool and do this:
-- import Data.Bool
(bool (doesDirectoryExist a) (pure False) $ null a) >>= \case
("bool" is just a more functional-like notation for the good old if-then-else)
I know there is a Paginator package for Yesod but I prefer a simpler UI so I was creating a simple pagination logic for my app. However, I couldn't figure out a way to convert the parameter value to Integer.
import Data.Text (unpack, singleton)
import Data.Maybe
one = singleton '1' -- convert char to Text, required by fromMaybe
getTestPanelR :: Handler Html
getTestPanelR = do
ptext <- lookupGetParam "p" -- guessing returns Maybe Text
p <- fromMaybe one ptext -- ??? does not work
-- pn <- ??? Once p is extracted successfully, how to convert to an integer?
s <- runDB $ selectList [] [Asc PersonName, LimitTo 10 , OffsetBy $ (pn - 1) * 10]
(widget, enctype) <- generateFormPost $ entryForm Nothing
defaultLayout $ do
$(widgetFile "person")
When I run the above Code I get the following error message:
No instance for (MonadHandler Maybe)
arising from a use of `lookupGetParam'
Possible fix: add an instance declaration for (MonadHandler Maybe)
In the second argument of `($)', namely `lookupGetParam "p"'
In a stmt of a 'do' block:
p <- fromMaybe one $ lookupGetParam "p"
In the expression:
...
When I write out 'ptext' using #{show ptext} it shows Just "1". Having gotten the GET parameter, how do I convert it to an integer so I can do pagination? (need to add 1 for 'next' and subtract 1 for 'prev')
FWIW, when I try this using GHCi, it works fine:
Prelude Data.Maybe Data.Text> let one = singleton '1'
Prelude Data.Maybe Data.Text> let x = Just $ singleton '5'
Prelude Data.Maybe Data.Text> let y = fromMaybe one x
Prelude Data.Maybe Data.Text> y
"5"
Prelude Data.Maybe Data.Text> read $ Data.Text.unpack y ::Int -- This is probably unsafe because I cannot trust 'y' in my web app
5
Update:
I tired #Ankur's suggestion pageNumber <- (lookupGetParam "p" >>= return . (read :: String -> Int) . fromMaybe "1") and I get the following error:
Couldn't match expected type `String' with actual type `Text'
Expected type: Maybe Text -> String
Actual type: Maybe Text -> Text
In the return type of a call of `fromMaybe'
In the second argument of `(.)', namely `fromMaybe "1"'
Build failure, pausing...
If change the "1" to one (Data.Text.singleton '1'), I still get the exact same error message.
Thanks!
lookupGetParam returns ParamValue which is type ParamValue = String. So basically it is String rather than Text.
Try this:
pageNumber <- (lookupGetParam "p" >>= return . (read :: String -> Int) . fromMaybe "1")
UPDATE:
Actually the latest version of lookupGetParam is Text based so adding the OverloadedStrings language extension should get the job done:
Put this {-# LANGUAGE OverloadedStrings #-} at the start of the code file and use:
pageNumber <- (lookupGetParam "p" >>= return . (read :: String -> Int) . unpack . fromMaybe "1")
I'd like to save a huge list A to a textfile. writeFile seems to only save the list at the very end of the calcultaion of A, which crashes because my memory is insufficient to store the whole list.
I have tried this using
writeFile "test.txt" $ show mylistA
Now I have tried saving the elements of the list, as they are calculated using:
[appendFile "test2.txt" (show x)|x<-mylistA]
But it doesn't work because:
No instance for (Show (IO ())) arising from a use of `print' Possible fix: add an instance declaration for (Show (IO ())) In a stmt of an interactive GHCi command: print it
Can you help me fix this, or give me a solution which saves my huge list A to a text file?
Thank you
The problem is that your list has the type [ IO () ] or "A list of IO actions". Since the IO is on the "inside" of out type we can't execute this in the IO monad. What we want instead is IO (). So a list comprehension isn't going to hack it here.
We could use a function to turn [IO ()] -> IO [()] but this case lends itself to a much more concise combinator.
Instead we can use a simple predefined combinator called mapM_. In the Haskell prelude the M means it's monadic and the _ means that it returns m () in our case IO (). Using it is trivial in this case
[appendFile "test2.txt" (show x)|x<-mylistA]
becomes
mapM_ (\x -> appendFile "test2.txt" (show x)) myListA
mapM_ (appendFile "test2.txt" . show) myListA
This will unfold to something like
appendFile "test2.txt" (show firstItem) >>
appendFile "test2.txt" (show secondItem) >>
...
So we don't ever have the whole list in memory.
You can use the function sequence from Control.Monad to take a (lazily generated) list of IO actions and execute them one at a time
>>> import Control.Monad
Now you can do
>>> let myList = [1, 2, 3]
>>> sequence [print x | x <- myList]
1
2
3
[(),(),()]
Note that you get a list of all the return values at the end. If you want to discard the return value, just use sequence_ instead of sequence.
>>> sequence_ [print x | x <- myList]
1
2
3
I just wanted to expand on jozefg's answer by mentioning forM_, the flipped version of mapM_. Using forM_ you get something that looks like a foreach loop:
-- Read this as "for each `x` in `myListA`, do X"
forM_ myListA $ \x -> do
appendFile "test2.txt" (show x)
I often find myself wanting to insert regular functions into a "binded" sequence. Like in this contrived example:
getLine >>= lift (map toUpper) >>= putStrLn
I need to define the lift function lift :: (a -> b) -> a -> m b to make this work. Problem is I don't know of such a function, and Hoogle doesn't seem to either. I find this odd since this makes totally sense to me.
Now, there are probably other ways to make this work, but I like the way point-free style code allows me to scan the line in one pass to figure out what is happening.
let lift f x = return (f x) in
getLine >>= lift (map toUpper) >>= putStrLn
My question boils down to this: am I missing something or how come there isn't a function like lift. My experience in Haskell is still very limited, so I am assuming that most people solve this in a different way. Can someone explain to me the idiomatic way of solving this.
There are three idiomatic ways.
Don't use bind; use the first hit on your Hoogle search instead:
liftM (map toUpper) getLine >>= putStrLn
There are a variety of alternative spellings of liftM, such as fmap or (<$>).
Inline the lift function you defined:
getLine >>= return . map toUpper >>= putStrLn
Use the monad laws to fuse the last two binds in option 2:
getLine >>= putStrLn . map toUpper
Use the Functor instance in such cases:
> import Data.Char
> import Data.Functor
> map toUpper <$> getLine >>= putStrLn
foo
FOO
>