ParserUnbiasedChoiceMonadEmbedding

Documentation

Example. Let's parse (and calculate) such expressions: "( 1 * 2 / 3 )". We will use tokenizer similar to "words", so we place spaces between all tokens. Parens () are not mandatory around every subterm, i. e. ( 1 * 2 ) is ok and 1 * 2 is ok, too.

>>> :set -XHaskell2010
>>> :set -XRecursiveDo
>>> :set -XArrows
>>> import Control.Arrow(returnA)
>>> import Text.Earley(fullParses, Report(..))
>>> import Control.Monad(when)
>>> import Language.Lexer.Applicative(Lexer, token, longest, whitespace, streamToEitherList, runLexer, LexicalError(..))
>>> import Text.Regex.Applicative(psym, string)
>>> import ParserUnbiasedChoiceMonadEmbedding
>>> :{
grammar :: Grammar r (ArrowProd r () String (Either String) () Int)
grammar = mdo {
  num <- arrowRule $ msym $ \tok -> if all (`elem` ['0'..'9']) tok then Just $ read tok else Nothing;
  term <- arrowRule $ num <|> (sym "(" *> expr <* sym ")");
  expr <- arrowRule $ term <|> ((*) <$> (expr <* sym "*") <*> term) <|> (proc () -> do {
    L xl x <- loc expr -< ();
    sym "/" -< ();
    L yl y <- loc term -< ();
    lift -< when (y == 0) $ Left $ "Division by zero. Attempting to divide this expression: " ++ showLoc xl ++ " by this expression: " ++ showLoc yl;
    returnA -< div x y;
  });
  return expr;
}
lexer :: Lexer String
lexer = mconcat [
    token $ longest $ many $ psym (/= ' '),
    whitespace $ longest $ string " "
  ]
:}

>>> :{
case streamToEitherList $ runLexer lexer "-" "6 / 3 * 21" of {
  Left (LexicalError (Pos _ line col _)) -> putStrLn $ "Lexer error at " ++ show line ++ " " ++ show col;
  Right tokens -> case fullParses (arrowParser grammar) tokens of {
    ([], Report pos _ _) -> putStrLn $ "Parser error: " ++ showLoc (positionToLoc tokens pos) ++ ": no parse";
    ([m], _) -> case m of {
      Left e -> putStrLn $ "Semantic error: " ++ e;
      Right x -> putStrLn $ "Result: " ++ show x;
    };
    (_, _) -> putStrLn "Ambiguity";
  };
}
:}
Result: 42

newtype ArrowProd r e t m b c

Constructors

ArrowProd (Prod r e (L t) (L (b -> m c)))

Instances

Monad m => Category (ArrowProd r e t m :: Type -> Type -> Type)

Defined in ParserUnbiasedChoiceMonadEmbedding

Methods

id :: forall (a :: k). ArrowProd r e t m a a

(.) :: forall (b :: k) (c :: k) (a :: k). ArrowProd r e t m b c -> ArrowProd r e t m a b -> ArrowProd r e t m a c

Monad m => Arrow (ArrowProd r e t m)

Defined in ParserUnbiasedChoiceMonadEmbedding

Methods

arr :: (b -> c) -> ArrowProd r e t m b c

first :: ArrowProd r e t m b c -> ArrowProd r e t m (b, d) (c, d)

second :: ArrowProd r e t m b c -> ArrowProd r e t m (d, b) (d, c)

(***) :: ArrowProd r e t m b c -> ArrowProd r e t m b' c' -> ArrowProd r e t m (b, b') (c, c')

(&&&) :: ArrowProd r e t m b c -> ArrowProd r e t m b c' -> ArrowProd r e t m b (c, c')

Functor m => Functor (ArrowProd r e t m b)

Defined in ParserUnbiasedChoiceMonadEmbedding

Methods

fmap :: (a -> b0) -> ArrowProd r e t m b a -> ArrowProd r e t m b b0

(<$) :: a -> ArrowProd r e t m b b0 -> ArrowProd r e t m b a

Applicative m => Applicative (ArrowProd r e t m b)

Defined in ParserUnbiasedChoiceMonadEmbedding

Methods

pure :: a -> ArrowProd r e t m b a

(<*>) :: ArrowProd r e t m b (a -> b0) -> ArrowProd r e t m b a -> ArrowProd r e t m b b0

liftA2 :: (a -> b0 -> c) -> ArrowProd r e t m b a -> ArrowProd r e t m b b0 -> ArrowProd r e t m b c

(*>) :: ArrowProd r e t m b a -> ArrowProd r e t m b b0 -> ArrowProd r e t m b b0

(<*) :: ArrowProd r e t m b a -> ArrowProd r e t m b b0 -> ArrowProd r e t m b a

Applicative m => Alternative (ArrowProd r e t m b)

Defined in ParserUnbiasedChoiceMonadEmbedding

Methods

empty :: ArrowProd r e t m b a

(<|>) :: ArrowProd r e t m b a -> ArrowProd r e t m b a -> ArrowProd r e t m b a

some :: ArrowProd r e t m b a -> ArrowProd r e t m b [a]

many :: ArrowProd r e t m b a -> ArrowProd r e t m b [a]

msym :: Applicative m => (t -> Maybe c) -> ArrowProd r e t m () c

sym :: (Applicative m, Eq t) => t -> ArrowProd r e t m () t

lift :: ArrowProd r e t m (m c) c

loc :: Applicative m => ArrowProd r e t m b c -> ArrowProd r e t m b (L c)

arrowRule :: ArrowProd r e t m b c -> Grammar r (ArrowProd r e t m b c)

arrowParser :: (forall r. Grammar r (ArrowProd r e t m () c)) -> Parser e [L t] (m c)

showLoc :: Loc -> String

positionToLoc :: [L a] -> Int -> Loc

This function is buggy: if a file contains no tokens, the file name will not be returned