[Haskell-cafe] parsec3 pre-release [attempt 2]

Antoine Latter aslatter at gmail.com
Sat Feb 2 21:43:09 EST 2008


On Feb 2, 2008 5:28 PM, Antoine Latter <aslatter at gmail.com> wrote:
> I'm not a fan of parameterizing the "Stream" class over the monad parameter `m':
>
> > class Stream s m t | s -> t where
> >    uncons :: s -> m (Maybe (t,s))
>
> which leads to instance declarations like so:
>
> > instance Monad m => Stream [tok] m tok where
> >     uncons []     = return $ Nothing
> >     uncons (t:ts) = return $ Just (t,ts)
>

To expand on this point, side-effect instances of Stream don't play
nice with the backtracking in Text.Parsec.Prim.try:

> import Text.Parsec
> import Text.Parsec.Prim
> import System.IO
> import Control.Monad

> type Parser a = (Stream s m Char) => ParsecT s u m a

This particular instance was suggested by Derek.

> instance Stream Handle IO Char where
>    uncons hdl = do
>        b <- hIsEOF hdl
>        if b then return Nothing
>             else liftM (\c -> Just (c,hdl)) getChar

> testParser :: Parser String
> testParser = try (string "hello1") <|> string "hello2"

> test1 = runPT testParser () "stdin" stdin >>= print
> test2 = hGetLine stdin >>= print . runP testParser () "stdin"

"test1" uses the  (Stream Handle IO Char) instance, "test2" uses the
(Monad m => Stream [a] m a) instance.

For input "hello2", test2 produces a valid parse while test1 does not.

-Antoine


More information about the Haskell-Cafe mailing list