[Haskell-cafe] Pearl! I just proved theorem about impossibility of monad transformer for parsing with (1) unbiased choice and (2) ambiguity checking before running embedded monadic action (also, I THREAT I will create another parsing lib)

Askar Safin safinaskar at mail.ru
Sat Jun 12 00:24:16 UTC 2021


> Details aside, this sounds like an instance of the common relationship between
Hi. Thanks for answer! Applicative is not for me. Let's imagine hypothetical "Parser", which is instance of Applicative, but not Monad. It can fail with some error message.
This is how expressions like (1+(1+1)) can be parsed with it:
--------
{-# LANGUAGE ApplicativeDo #-}
char :: Char -> Parser Char
char = ...
p :: Parser Int
p = do { -- applicative do
  char '1';
  pure 1;
} <|> do {
  char '(';
  a <- p;
  char '+';
  b <- p;
  char ')';
  pure $ a + b;
}
-------
Okey, everything is OK, but how to fail with message? Let's imagine we have such function:

failWith :: String -> Parser a

How to use it? Let's try:
-----
q :: Parser Int
q = do {
  char '(';
  a <- p;
  char '/';
  b <- p;
  char ')';
  if b == 0 then failWith "division by zero" else pure (a / b);
}
-----
Unfortunately, this cannot be desugared as Applicative. So, we need this function instead:

fromEither :: Parser (Either String a) -> Parser a

Now we can write this:
-----
q :: Parser Int
q = fromEither $ do { -- applicative do
  char '(';
  a <- p;
  char '/';
  b <- p;
  char ')';
  pure $ do { -- normal monadic do
    when (b == 0) $ Left "division by zero";
    return $ a / b;
  };
}
------
Yay! Now everything works with Applicative. Moreover, it seems we can embed arbitrary Monad this way. But this is ugly. Because:
1. We use two-level do. One applicative and one monadic
2. We need to prepend "fromEither" before each parser, in which we plan to fail with error messages.

So, I think arrow parsing will be more natural

==
Askar Safin
http://safinaskar.com
https://sr.ht/~safinaskar
https://github.com/safinaskar


More information about the Haskell-Cafe mailing list