
Hi there, I'm learning haskell for weeks and I'm trying to write a parser using haskell. First I create a datatype: newtype Parser a = P (String -> [(a, String)]) I create a function called `bind` : bind :: Parser a -> ( a -> Parser b) -> Parser b bind f g = P $ \s -> concatMap (\(a, s') -> parse (g a) s') $ parse f s and then: instance Monad Parser where (>>=) = bind that's looks cool, than I write a function liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c >>= (\x -> return (x, cs)) It works well, then I change this function to liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c `bind` (\x -> return (x, cs)) GHC throw errors: regular.hs|153 col 14 error| • Couldn't match expected type ‘Parser t0’ with actual type ‘[a]’ • In the first argument of ‘bind’, namely ‘f c’ In the expression: f c `bind` (\ x -> return (x, cs)) In an equation for ‘g’: g (c : cs) = f c `bind` (\ x -> return (x, cs)) • Relevant bindings include f :: Char -> [a] (bound at regular.hs:151:11) liftToken :: (Char -> [a]) -> Parser a (bound at regular.hs:151:1) That's really confusing, why I can use (>>=) but I can't use `bind`? Is there any difference between them?

On 10 October 2017 at 22:34, mirone
Hi there, I'm learning haskell for weeks and I'm trying to write a parser using haskell. First I create a datatype: newtype Parser a = P (String -> [(a, String)]) I create a function called `bind` : bind :: Parser a -> ( a -> Parser b) -> Parser b bind f g = P $ \s -> concatMap (\(a, s') -> parse (g a) s') $ parse f s and then: instance Monad Parser where (>>=) = bind that's looks cool, than I write a function liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c >>= (\x -> return (x, cs))
Here, f c :: [a], so you're using the [] instance of Monad, hence (>>=) :: [a] -> (a -> [b]) -> [b]
It works well, then I change this function to liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c `bind` (\x -> return (x, cs)) GHC throw errors: regular.hs|153 col 14 error| • Couldn't match expected type ‘Parser t0’ with actual type ‘[a]’ • In the first argument of ‘bind’, namely ‘f c’ In the expression: f c `bind` (\ x -> return (x, cs)) In an equation for ‘g’: g (c : cs) = f c `bind` (\ x -> return (x, cs)) • Relevant bindings include f :: Char -> [a] (bound at regular.hs:151:11) liftToken :: (Char -> [a]) -> Parser a (bound at regular.hs:151:1)
That's really confusing, why I can use (>>=) but I can't use `bind`? Is there any difference between them?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com http://IvanMiljenovic.wordpress.com

On October 10, 2017 6:43:41 AM CDT, Ivan Lazar Miljenovic
Hi there, I'm learning haskell for weeks and I'm trying to write a parser using haskell. First I create a datatype: newtype Parser a = P (String -> [(a, String)]) I create a function called `bind` : bind :: Parser a -> ( a -> Parser b) -> Parser b bind f g = P $ \s -> concatMap (\(a, s') -> parse (g a) s') $
On 10 October 2017 at 22:34, mirone
wrote: parse f s and then: instance Monad Parser where (>>=) = bind that's looks cool, than I write a function liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c >>= (\x -> return (x, cs))
Here, f c :: [a], so you're using the [] instance of Monad, hence (>>=) :: [a] -> (a -> [b]) -> [b]
Yep, and >>= for [a] will often have different semantics then whatever monad you had in mind. You can inject the list into the parser monad by using return. return (f c) `bind` (\x -> return (x, cs))
It works well, then I change this function to liftToken :: (Char -> [a]) -> Parser a liftToken f = P g where g [] = [] g (c:cs) = f c `bind` (\x -> return (x, cs)) GHC throw errors: regular.hs|153 col 14 error| • Couldn't match expected type ‘Parser t0’ with actual type ‘[a]’ • In the first argument of ‘bind’, namely ‘f c’ In the expression: f c `bind` (\ x -> return (x, cs)) In an equation for ‘g’: g (c : cs) = f c `bind` (\ x -> return (x, cs)) • Relevant bindings include f :: Char -> [a] (bound at regular.hs:151:11) liftToken :: (Char -> [a]) -> Parser a (bound at regular.hs:151:1)
That's really confusing, why I can use (>>=) but I can't use `bind`? Is there any difference between them?
_______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- Ivan Lazar Miljenovic Ivan.Miljenovic@gmail.com http://IvanMiljenovic.wordpress.com _______________________________________________ Haskell-Cafe mailing list To (un)subscribe, modify options or view archives go to: http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe Only members subscribed via the mailman list are allowed to post.
-- Sent from my Android device with K-9 Mail. Please excuse my brevity.
participants (3)
-
Ivan Lazar Miljenovic
-
jpaugh@gmx.com
-
mirone