I am trying to understand do-blocks/sequencing actions, parsers and monads.
newtype Parser a = P ( String -> [ ( a, String ) ] )
item :: Parser Char
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
parse :: Parser a -> String -> [(a,String)]
parse (P p) inp = p inp
firstThird :: Parser (Char,Char)
firstThird = do x <- item
item
y <- item
return (x,y)
I don't understand why
parse firstThird "ab"
evaluates to
[]
Why is it when one of the actions fail the whole do-block fails?
You haven't included a Monad instance for your Parser, but a standard one might be given by:
instance Functor Parser where
fmap = liftM
instance Applicative Parser where
pure x = P $ \str -> [(x, str)]
(<*>) = ap
instance Monad Parser where
P p >>= f = P $ \str ->
[result | (x, rest) <- p str, let P q = f x, result <- q rest]
With this instance, I can duplicate your result, and the parser is operating as intended. Usually a monadic parser is designed so that when a sequence of parsers is bound together (using the >>= operator, or as multiple steps in do-block notation), the intended meaning is that each parser is tried in sequence and must "succeed" in order for the entire sequence to be successful.
In your case, "success" is defined as a parser returning a non-empty list of possible parses. In order for firstThird to return a non-empty list, each of the three item parsers, in sequence, must produce a non-empty list. For the input string "ab", the first call to item produces the non-empty list [('a',"b")], the second call to item produces the non-empty list [('b',"")], and the third call to item has nothing left to parse and so returns the empty list []. No other parse is possible.
If you want to allow a parser to fail but continue the parse, you can use a combinator. There's a standard one named optional in Control.Applicative.
To use it, you'd need an Alternative instance for your Parser:
instance Alternative Parser where
empty = P $ \_ -> []
P p <|> P q = P $ \str -> p str ++ q str
instance MonadPlus Parser
and then you can write:
firstThird :: Parser (Char,Char)
firstThird = do x <- item
optional item
y <- item
return (x,y)
which allows:
> parse firstThird "ab"
[(('a','b'),"")]
> parse firstThird "abc"
[(('a','c'),""),(('a','b'),"c")]
Note that "abc" can be parsed two ways with firstThird, with and without skipping parsing for the middle item.
This is the usual way of writing monadic parsers: the Monad is used for a sequence of parses, all of which must succeed, while the separate Alternative (AKA MonadPlus) instance and the <|> operator in particular are used to gracefully handle cases where parsers are allowed to fail and allow other parsers to be tried instead.
Related
This is the exercise from https://haskell.mooc.fi/ training
-- Ex 5: define the IO operation readUntil f, which reads lines from
-- the user and returns them as a list. Reading is stopped when f
-- returns True for a line. (The value for which f returns True is not
-- returned.)
--
-- Example in GHCi:
-- *Set11> readUntil (=="STOP")
-- bananas
-- garlic
-- pakchoi
-- STOP
-- ["bananas","garlic","pakchoi"]
readUntil :: (String -> Bool) -> IO [String]
readUntil f = todo
Would you be able to provide me a hint / solution using do notation ?
I am a beginning with the do notation and the "conditional logic" as well as looping is too complex for me at the moment.
Thank you so much
With only do-notation and conditional statements I found the following solution:
readUntil :: (String -> Bool) -> IO [String]
readUntil f = do x <- getLine;
if f x then (return []) else (do xs <- readUntil f
return (x : xs))
The function first reads one line with getLine from prelude and then checks whether (f x) is true. It then returns just the empty list. We can't just write ... if f x then [] ... because [] has not the type IO [String] but just [String]. To make [] the type IO [String] we can use the function return or pure but with do-notation I use the return function, because it is included in the Monad typeclass.
If f x equals False we then use a second do-block to recursively call the function again and again until we get an Input for which f x == True and therefore returns the empty list. The do-notation is necessary because xs must have type [String], but readUntil has the type IO [String]. We can't use the : ("cons") operator with object of type IO String and therefore can't generate the list we want. We then add x to the list xs of all our other inputs and return it.
For a more general version of the function readUntil which is able to work with any monad and not just the IO Monad, see the comment of Will Ness
I wrote a simple function
someFunc list elem = do
list <- elem:elem:elem:list
return elem
Now, when i'm using it, i'm getting output like this
*Main> someFunc [] 'a'
"aaa"
Despite the fact, that this function has no practical use, why does it happen? Why does editing list have any effect in elem? And how to assign new value to list avoiding this situation?
Note that your function will be de-sugared into this:
someFunc :: [b] -> b -> [b]
someFunc list elem = (elem:elem:elem:list) >>= \list -> return elem
Now note that the list in \list -> return elem is different from the input list you pass to the function.
Now see how the Monad instance for list is defined:
instance Monad [] where
return x = [x]
xs >>= f = concat (map f xs)
fail _ = []
So, your code is translated to this form finally:
someFunc list elem = concat $ map (\list -> return elem) (elem:elem:elem:list)
Now can you understand why you are getting that output ?
someFunc [] 'a' will get be applied like this:
concat $ map (\list -> return 'a') ('a':'a':'a':[])
concat $ [['a'],['a'],['a']]
'a':'a':'a':[]
"aaa"
You can't assign a new value to list, what's happening is the list on the left of the <- is different than the list on the right of the <-. If you turn on warnings with -Wall you'll see
<interactive>:13:19: Warning:
This binding for `elem' shadows the existing binding
imported from `Prelude' (and originally defined in `GHC.List')
<interactive>:14:7: Warning:
This binding for `list' shadows the existing binding
bound at <interactive>:13:14
<interactive>:14:7: Warning: Defined but not used: `list'
You aren't using the name list defined by list <- ..., just defining it so that it happens to shadow the existing binding.
The reason someFunc [] 'a' returns "aaa" is due to how the list monad works. This do notation would be equivalent to
someFunc list e = (e:e:e:list) >>= \l -> return e
And for lists, >>= is essentially concatMap, so you have
someFunc list e = concatMap (\l -> return e) (e:e:e:list)
So substituting in [] for list and 'a' for e we get
someFunc [] 'a' = concatMap (\l -> return 'a') "aaa"
= concat $ map (\l -> return 'a') "aaa"
= concat [['a'], ['a'], ['a']]
= ['a', 'a', 'a']
= "aaa"
Your confusion probably comes from the use of return. In most languages return is a keyword, but in Haskell it's just a function. It does not exit a function call early, all it does is wrap a value in the context of the monad you're in. For lists return x = [x], that's the entire definition. Additionally, in Haskell you can't reassign values, but you can shadow them with a new definition. If you always compile with -Wall and -Werror though, you'll keep yourself from having this problem.
You are (apparently accidentally) using the list monad. In Python, your snippet would be expressed as:
for list in [elem, elem, elem] + list:
yield elem
That is, you create a list containing one elem for each item in the list, plus three more.
Here's what you probably intended:
someFunc list elem = do
list <- return (elem:elem:elem:list)
return elem
This just creates a new list variable shadowing your old one, and completely ignores it to return elem.
Say I have a List of integers l = [1,2]
Which I want to print to stdout.
Doing print l produces [1,2]
Say I want to print the list without the braces
map print l produces
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
`:t print
print :: Show a => a -> IO ()
So while I thought this would work I went ahead and tried:
map putStr $ map show l
Since I suspected a type mismatch from Integer to String was to blame. This produced the same error message as above.
I realize that I could do something like concatenating the list into a string, but I would like to avoid that if possible.
What's going on? How can I do this without constructing a string from the elements of the List?
The problem is that
map :: (a -> b) -> [a] -> [b]
So we end up with [IO ()]. This is a pure value, a list of IO actions. It won't actually print anything. Instead we want
mapM_ :: (a -> IO ()) -> [a] -> IO ()
The naming convention *M means that it operates over monads and *_ means we throw away the value. This is like map except it sequences each action with >> to return an IO action.
As an example mapM_ print [1..10] will print each element on a new line.
Suppose you're given a list xs :: [a] and function f :: Monad m => a -> m b. You want to apply the function f to each element of xs, yielding a list of actions, then sequence these actions. Here is how I would go about constructing a function, call it mapM, that does this. In the base case, xs = [] is the empty list, and we simply return []. In the recursive case, xs has the form x : xs. First, we want to apply f to x, giving the action f x :: m b. Next, we want recursively call mapM on xs. The result of performing the first step is a value, say y; the result of performing the second step is a list of values, say ys. So we collect y and ys into a list, then return them in the monad:
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM f [] = return []
mapM f (x : xs) = f x >>= \y -> mapM f ys >>= \ys -> return (y : ys)
Now we can map a function like print, which returns an action in the IO monad, over a list of values to print: mapM print [1..10] does precisely this for the list of integers from one through ten. There is a problem, however: we aren't particularly concerned about collecting the results of printing operations; we're primarily concerned about their side effects. Instead of returning y : ys, we simply return ().
mapM_ :: Monad m => (a -> m b) ->[a] -> m ()
mapM_ f [] = return ()
mapM_ f (x : xs) = f x >> mapM_ f xs
Note that mapM and mapM_ can be defined without explicit recursion using the sequence and sequence_ functions from the standard library, which do precisely what their names imply. If you look at the source code for mapM and mapM_ in Control.Monad, you will see them implemented that way.
Everything in Haskell is very strongly typed, including code to perform IO!
When you write print [1, 2], this is just a convenience wrapper for putStrLn (show [1, 2]), where show is a function that turns a (Show'able) object into a string. print itself doesn't do anything (in the side effect sense of do), but it outputs an IO() action, which is sort of like a mini unrun "program" (if you excuse the sloppy language), which isn't "run" at its creation time, but which can be passed around for later execution. You can verify the type in ghci
> :t print [1, 2]
print [1, 2]::IO()
This is just an object of type IO ().... You could throw this away right now and nothing would ever happen. More likely, if you use this object in main, the IO code will run, side effects and all.
When you map multiple putStrLn (or print) functions onto a list, you still get an object whose type you can view in ghci
> :t map print [1, 2]
map print [1, 2]::[IO()]
Like before, this is just an object that you can pass around, and by itself it will not do anything. But unlike before, the type is incorrect for usage in main, which expects an IO() object. In order to use it, you need to convert it to this type.
There are many ways to do this conversion.... One way that I like is the sequence function.
sequence $ map print [1, 2]
which takes a list of IO actions (ie- mini "programs" with side effects, if you will forgive the sloppy language), and sequences them together as on IO action. This code alone will now do what you want.
As jozefg pointed out, although sequence works, sequence_ is a better choice here....
Sequence not only concatinates the stuff in the IO action, but also puts the return values in a list.... Since print's return value is IO(), the new return value becomes a useless list of ()'s (in IO). :)
Using the lens library:
[1,2,3] ^! each . act print
You might write your own function, too:
Prelude> let l = [1,2]
Prelude> let f [] = return (); f (x:xs) = do print x; f xs
Prelude> f l
1
2
i have this problem:
i want to have a list of strings representing math expression, and a map of arguments to replace the variables.
so if my list is like ["x","+","y","-","5"] and arguments are [("x","5"),("y","4")]
the function should return ["5","+","4","-","5"]
i have this function to find key from map (from the Learn you a haskell book)
findKey :: (Eq k) => k -> [(k,v)] -> Maybe v
findKey key [] = Nothing
findKey key ((k,v): xs) =
if key == k
then Just v
else findKey key xs
and then my function to replace the variables with values
takeValuesFromMap (x:str) m result
|x == [] = result
|findKey x m == Nothing = takeValuesFromMap str m (result++[x])
|otherwise = takeValuesFromMap str m result++[fromJust (findKey x m)]
if no match in the map, we pass the regular string. Otherwise we pass to the result the value staying next to the key that matches.
but in the end when i call
takeValuesFromMap ["x","+","y","-","5"] (Map.fromList [("x","5"),("y","4")]) []
it says
Solver.hs:63:48:
Couldn't match expected type `[([Char], [Char])]'
with actual type `Map.Map [Char] [Char]'
In the return type of a call of `Map.fromList'
In the second argument of `takeValuesFromMap', namely
`(Map.fromList [("x", "5"), ("y", "4")])'
In the expression:
takeValuesFromMap
["x", "+", "y", "-", ....]
(Map.fromList [("x", "5"), ("y", "4")])
[]
any idea how to fix this?
I'm going to take a different track here, and suggest that you don't solve this problem. The reason is that the list ["x","+","y","-","5"] is a very poor representation of the algebraic expression x + y - 5. I don't know exactly what you're trying to do, but a better approach would represent the expression as an abstract syntax tree, using an algebraic datatype.
So for example, we could use the following type to represent the expressions:
data Expr a = Variable String
| Literal a
| Plus Expr Expr
| Minus Expr Expr
Given this type, your example goes like this:
example :: Expr Integer
example = Minus (Plus (Var "x") (Var "y")) (Literal 5)
It's easy to write a function that evaluates expressions of this type, given a Map from variable names to values:
-- | Evaluate an expression, reading variable's values from the given environment
-- (the Map argument). Returns Nothing if any of the variables is undefined.
eval :: Num a => Expr a -> Map String a -> Maybe a
eval (Variable v) env = Map.lookup v env
eval (Literal x) _ = Just x
eval (Plus x y) env =
-- If this is confusing, read up on the Maybe monad in Learn You a Haskell
do x' <- eval x env
y' <- eval y env
return (x + y)
eval (Minus x y) env =
do x' <- eval x env
y' <- eval y env
return (x - y)
More complex, but well worth learning, is then to write a parser that takes a string and turns it into an Expr. If you're reading Learn You A Haskell, you may want to first get more comfortable with monads and applicatives. But when you're ready to take that step, there's a number of pages on the web with calculator parser examples:
http://meta-meta.blogspot.com/2007/10/simple-infix-calculator-in-haskell.html
http://www.youtube.com/playlist?list=PL_xuff3BkASMOzBr0hKVKLuSnU4UIinKx
http://haskelladdict.wordpress.com/2009/02/01/a-nice-little-calculator-implemented-in-haskell-and-parsec/
Though you may want to read this part of Real World Haskell first:
http://book.realworldhaskell.org/read/using-parsec.html
In findKey you require an association list, but you are actually using a Map. So, one way to fix it woulde be to remove Map.fromList.
Another point: Never replace pattern matching with equality checks! So please write:
| [] <- x = ...
| Nothing <- findKey x m = ...
Inspect the type of Map.fromList. Am I right in assuming that you take Map from Data.Map? If so:
:t Data.Map.fromList
Data.Map.fromList :: Ord k => [(k, a)] -> Map k a
So, this function returns Map, but your findKey actuall wants a list of tuples [([Char],[Char])]. You have got two choices now:
Use a function from Data.Map instead of your findKey to lookup a key.
Use another function to build your list.
I'm trying to understand how Haskell list comprehensions work "under the hood" in regards to pattern matching. The following ghci output illustrates my point:
Prelude> let myList = [Just 1, Just 2, Nothing, Just 3]
Prelude> let xs = [x | Just x <- myList]
Prelude> xs
[1,2,3]
Prelude>
As you can see, it is able to skip the "Nothing" and select only the "Just" values. I understand that List is a monad, defined as (source from Real World Haskell, ch. 14):
instance Monad [] where
return x = [x]
xs >>= f = concat (map f xs)
xs >> f = concat (map (\_ -> f) xs)
fail _ = []
Therefore, a list comprehension basically builds a singleton list for every element selected in the list comprehension and concatenates them. If a pattern match fails at some step, the result of the "fail" function is used instead. In other words, the "Just x" pattern doesn't match so [] is used as a placeholder until 'concat' is called. That explains why the "Nothing" appears to be skipped.
What I don't understand is, how does Haskell know to call the "fail" function? Is it "compiler magic", or functionality that you can write yourself in Haskell? Is it possible to write the following "select" function to work the same way as a list comprehension?
select :: (a -> b) -> [a] -> [b]
select (Just x -> x) myList -- how to prevent the lambda from raising an error?
[1,2,3]
While implemenatations of Haskell might not do it directly like this internally, it is helpful to think about it this way :)
[x | Just x <- myList]
... becomes:
do
Just x <- myList
return x
... which is:
myList >>= \(Just x) -> return x
As to your question:
What I don't understand is, how does Haskell know to call the "fail" function?
In do-notation, if a pattern binding fails (i.e. the Just x), then the fail method is called. For the above example, it would look something like this:
myList >>= \temp -> case temp of
(Just x) -> return x
_ -> fail "..."
So, every time you have a pattern-match in a monadic context that may fail, Haskell inserts a call to fail. Try it out with IO:
main = do
(1,x) <- return (0,2)
print x -- x would be 2, but the pattern match fails
The rule for desugaring a list comprehension requires an expression of the form [ e | p <- l ] (where e is an expression, p a pattern, and l a list expression) behave like
let ok p = [e]
ok _ = []
in concatMap ok l
Previous versions of Haskell had monad comprehensions, which were removed from the language because they were hard to read and redundant with the do-notation. (List comprehensions are redundant, too, but they aren't so hard to read.) I think desugaring [ e | p <- l ] as a monad (or, to be precise, as a monad with zero) would yield something like
let ok p = return e
ok _ = mzero
in l >>= ok
where mzero is from the MonadPlus class. This is very close to
do { p <- l; return e }
which desugars to
let ok p = return e
ok _ = fail "..."
in l >>= ok
When we take the List Monad, we have
return e = [e]
mzero = fail _ = []
(>>=) = flip concatMap
I.e., the 3 approaches (list comprehensions, monad comprehensions, do expressions) are equivalent for lists.
I don't think the list comprehension syntax has much to do with the fact that List ([]), or Maybe for that matter, happens to be an instance of the Monad type class.
List comprehensions are indeed compiler magic or syntax sugar, but that's possible because the compiler knows the structure of the [] data type.
Here's what the list comprehension is compiled to: (Well, I think, I didn't actually check it against the GHC)
xs = let f = \xs -> case xs of
Just x -> [x]
_ -> []
in concatMap f myList
As you can see, the compiler doesn't have to call the fail function, it can simply inline a empty list, because it knows what a list is.
Interestingly, this fact that the list comprehensions syntax 'skips' pattern match failures is used in some libraries to do generic programming. See the example in the Uniplate library.
Edit: Oh, and to answer your question, you can't call your select function with the lambda you gave it. It will indeed fail on a pattern match failure if you call it with an Nothing value.
You could pass it the f function from the code above, but than select would have the type:
select :: (a -> [b]) -> [a] -> [b]
which is perfectly fine, you can use the concatMap function internally :-)
Also, that new select now has the type of the monadic bind operator for lists (with its arguments flipped):
(>>=) :: [a] -> (a -> [b]) -> [b]
xs >>= f = concatMap f xs -- 'or as you said: concat (map f xs)