3
    module Parser where

import           Control.Monad (MonadPlus, mplus, mzero)
import           Tagger        (Tag, Token)


newtype Parser a = Parser ([(Token, Tag)] -> [(a, [(Token, Tag)])])

parse :: Parser a -> [(Token, Tag)] -> [(a, [(Token, Tag)])]
parse (Parser p) = p

instance Functor Parser where
    fmap f p = do
        result <- p
        return (f result)

instance Monad Parser where
    return a = Parser (\cs -> [(a,cs)])
    p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])

instance MonadPlus Parser where 
    p `mplus` q = Parser (\cs -> parse p cs ++ parse q cs)
    mzero = Parser (const [])

{-

This is my code for my parser. Apparently I've done it "the old way" and cannot really get it to work the new way. Can you tell me which things I need to fix in order to make it work? I read this article (https://wiki.haskell.org/Functor-Applicative-Monad_Proposal) and tried to change my code but I think I'm doing something wrong here.

The compiling errors I get:

Parser.hs:56:10:
    No instance for (Applicative Parser)
      arising from the superclasses of an instance declaration
    In the instance declaration for ‘Monad Parser’

Parser.hs:60:10:
    No instance for (GHC.Base.Alternative Parser)
      arising from the superclasses of an instance declaration
    In the instance declaration for ‘MonadPlus Parser’

EDIT //

The code right now:

module Parser where

import           Control.Applicative
import           Control.Monad (mplus, mzero, liftM, ap)
import           Tagger        (Tag, Token)

-- type Token = String 
-- type Tag = String

newtype Parser a = Parser ([(Token, Tag)] -> [(a, [(Token, Tag)])])

parse :: Parser a -> [(Token, Tag)] -> [(a, [(Token, Tag)])]
parse (Parser p) = p

instance Functor Parser where
    fmap = liftM

instance Applicative Parser where
    pure a = Parser (\cs -> [(a,cs)])
    (<*>) = ap

instance Monad Parser where
    p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])

instance MonadPlus Parser where --64
    p `mplus` q = Parser (\cs -> parse p cs ++ parse q cs)
    mzero = Parser (const [])

instance Alternative Parser where
    (<|>) = mplus
    empty = mzero

(+++) :: Parser a -> Parser a -> Parser a
p +++ q = Parser (\cs -> case parse (p `mplus` q) cs of
                           [] -> []
                           (x:_) -> [x])

Error:

Parser.hs:64:10:
Not in scope: type constructor or class ‘MonadPlus’
duplode
  • 33,731
  • 7
  • 79
  • 150
katyp
  • 29
  • 4
  • You may follow the migration guide: https://ghc.haskell.org/trac/ghc/wiki/Migration/7.10 – zakyggaps Mar 30 '16 at 14:31
  • I guess you still need manual instances for Applicative (which will be very easy) and Alternative. – Bartek Banachewicz Mar 30 '16 at 14:32
  • Thanks for the suggestions! @zakyggaps I tried following the instructions on your link but unfortunately now have new errors which I'm not sure how I should fix. I probably still have to change something? – katyp Mar 30 '16 at 14:52
  • In your original definition of ">>=" you had the arguments "p" and "f". But in your definition of "*>" you don't have those arguments any more. What happens if you replace "(*>)" with "p *> f"? There is a similar confusion in your new definition of ">>=". Are you sure you understand how operator syntax works? – Paul Johnson Mar 30 '16 at 14:55
  • @PaulJohnson I replaced it and now it doesn't complain about them anymore, thankyou! Now it only complains about a (56), p (66) and q (66). I'm still very very new with Haskell and haven't used it very much so I still get confused with quite many things sometimes. I'm doing my best to learn but it's very different. – katyp Mar 30 '16 at 14:59
  • @katyp OK, now try the same change on the other functions. Think about "pure" and "return": they are actually the same thing. – Paul Johnson Mar 30 '16 at 15:03

1 Answers1

3

You may follow the migration guide. It's simple and straightforward: move the definition of return to pure, add the boilerplate definition of <*> and remove return from the monad instance:

instance Functor Parser where
    fmap = liftM

instance Applicative Parser where
    pure a = Parser (\cs -> [(a,cs)])
    (<*>) = ap

instance Monad Parser where
    p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])

For Alternative it's boilerplate and nothing else:

instance Alternative Parser where 
    (<|>) = mplus 
    empty = mzero

The working code as a whole:

module Parser where

import           Control.Monad
import           Tagger        (Tag, Token)
import           Control.Applicative

newtype Parser a = Parser ([(Token, Tag)] -> [(a, [(Token, Tag)])])

parse :: Parser a -> [(Token, Tag)] -> [(a, [(Token, Tag)])]
parse (Parser p) = p

instance Functor Parser where
    fmap = liftM

instance Applicative Parser where
    pure a = Parser (\cs -> [(a,cs)])
    (<*>) = ap

instance Monad Parser where
    p >>= f = Parser (\cs -> concat [parse (f a) cs' | (a,cs') <- parse p cs])

instance MonadPlus Parser where
    p `mplus` q = Parser (\cs -> parse p cs ++ parse q cs)
    mzero = Parser (const [])

instance Alternative Parser where
    (<|>) = mplus
    empty = mzero
zakyggaps
  • 3,070
  • 2
  • 15
  • 25
  • So what is "a" in the definition of "pure"? – Paul Johnson Mar 30 '16 at 15:05
  • 1
    @PaulJohnson Sorry, fixed. – zakyggaps Mar 30 '16 at 15:05
  • This fix only gives error "Parser.hs:56:29: Not in scope: ‘a’" now, so there seems to be some kind of a problem with pure = Parser (\cs -> [(a,cs)]) or something? I'm very new with this and am not sure where the root of the problem is. – katyp Mar 30 '16 at 15:08
  • @katyp You should not remove the `MonadPlus` instance. The definition of `Alternative` depends on it. – zakyggaps Mar 30 '16 at 15:11
  • @zakyggaps Thankyou so much for your help! Now ghci still gives a compiling error for MonadPlus. I edited the original post – katyp Mar 30 '16 at 15:21
  • @katyp You forgot to import it from `Control.Monad`. It's not in the list now: `import Control.Monad (mplus, mzero, liftM, ap)` – zakyggaps Mar 30 '16 at 15:24
  • @zakyggaps You're right! This fixed the problem, now I get no errors :) Thankyou very much! – katyp Mar 30 '16 at 15:32