Parsec chainl1 on failure

Question

Я пытаюсь разобрать выражения из просто типизированного лямбда-исчисления (F1), и я немного борюсь с Parsec и не могу понять, насколько я могу решить свою проблему.

У меня есть следующий АТД:

newtype LambdaVar = LV Char 
    deriving (Eq, Ord) 

data Type 
    = TBool 
    | TNat 
    | Arr Type Type 
    deriving Eq 

data LambdaExpr 
    = Abstr LambdaVar Type LambdaExpr 
    | App LambdaExpr LambdaExpr 
    | Var LambdaVar 
    deriving Eq 

newtype TypeContext = TC [(LambdaVar, Type)] 
    deriving (Eq, Show) 

data Expression = Expr TypeContext LambdaExpr Type 
    deriving (Eq, Show) 

с этим анализатором:

type ParserT a b = ParsecT String a Identity b 

parens :: ParserT a b -> ParserT a b 
parens = between (char '(') (char ')') 

symbol :: String -> ParserT a String 
symbol p = spaces *> string p <* spaces 

typeParser :: CharParser() Type 
typeParser = arr <|> tbool <|> tnat 
    where tbool = const TBool <$> string "Bool" 
     tnat = const TNat <$> string "Nat" 
     subtyp = parens arr <|> tbool <|> tnat 
     arr = chainr1 subtyp $ try (symbol "->" *> pure Arr) 

lambdaParser :: CharParser() LambdaExpr 
lambdaParser = expr 
    where expr = pApp <|> pAbstr <|> pVar 
     pVar = Var . LV <$> letter 
     pAbstr = Abstr <$> (LV <$> (char '\\' *> letter)) <*> (symbol ":" *> typeParser) <*> (char '.' *> expr) 
     pApp = chainl1 subExpr (char ' ' *> pure App) 
     subExpr = parens pApp <|> pAbstr <|> pVar 

typeContextParser :: CharParser() TypeContext 
typeContextParser = TC <$> ((,) <$> (LV <$> letter <* symbol ":") <*> typeParser) `sepBy` try (symbol ",") 

expressionParser :: CharParser() Expression 
expressionParser = Expr <$> (typeContextParser <* symbol "|-") <*> (lambdaParser <* symbol ":") <*> try typeParser 

parse :: String -> Either ParseError Expression 
parse = P.parse expressionParser "" 

Теперь проблема возникает, когда то пытается разобрать выражение как

|- \x:Bool -> Nat.\y:Bool.x y : (Bool -> Nat) -> Bool -> Nat 

и я стараюсь для его анализа я получу ошибку:

unexpected ":" 
expecting "(", "\\" or letter 

Так что здесь происходит то, что у меня есть пробел после x y поэтому анализатор принимает это будет приложение, но затем находит :, который он не может разобрать, как один, но я понятия не имею, как исправить это поведение , Полагаю, мне придется как-то отступить с try, но я просто не могу заставить его работать.

Answer 1

Пожалуйста, включите ваш импорт - это упрощает работу с вашим кодом.

Я думаю, что я получил ваш синтаксический анализатор для работы, изменив все маркеры парсера, чтобы также использовать пробел сразу же после токена.

Например, заменить char x с (char x) <* spaces, string "->" с (string "->") <* spaces и т.д.

Вот рабочий код:

{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-} 

import Text.Parsec 
import qualified Text.Parsec as P 
import Text.Parsec.Expr 
import Text.ParserCombinators.Parsec.Char 
import Data.Functor.Identity 

newtype LambdaVar = LV Char 
    deriving (Eq, Ord, Show) 

data Type 
    = TBool 
    | TNat 
    | Arr Type Type 
    deriving (Eq, Show) 

data LambdaExpr 
    = Abstr LambdaVar Type LambdaExpr 
    | App LambdaExpr LambdaExpr 
    | Var LambdaVar 
    deriving (Eq, Show) 

newtype TypeContext = TC [(LambdaVar, Type)] 
    deriving (Eq, Show) 

data Expression = Expr TypeContext LambdaExpr Type 
    deriving (Eq, Show) 

type ParserT a b = ParsecT String a Identity b 

lexeme p = p <* spaces 

lchar = lexeme . char 
lstring = lexeme . string 

parens :: ParserT a b -> ParserT a b 
parens = between (lchar '(') (lchar ')') 

symbol :: String -> ParserT a String 
symbol p = string p <* spaces 

typeParser :: CharParser() Type 
typeParser = arr <|> tbool <|> tnat 
    where tbool = const TBool <$> lstring "Bool" 
     tnat = const TNat <$> lstring "Nat" 
     subtyp = parens arr <|> tbool <|> tnat 
     arr = chainr1 subtyp $ try (symbol "->" *> pure Arr) 

lambdaParser :: CharParser() LambdaExpr 
lambdaParser = expr 
    where expr = pApp <|> pAbstr <|> pVar 
     pVar = Var . LV <$> (lexeme letter) 
     pAbstr = Abstr <$> (LV <$> (lchar '\\' *> letter)) <*> (symbol ":" *> typeParser) <*> (lchar '.' *> expr) 
     pApp = chainl1 subExpr (pure App) 
     subExpr = parens pApp <|> pAbstr <|> pVar 

typeContextParser :: CharParser() TypeContext 
typeContextParser = TC <$> ((,) <$> (LV <$> letter <* symbol ":") <*> typeParser) `sepBy` try (symbol ",") 

expressionParser :: CharParser() Expression 
expressionParser = Expr <$> (typeContextParser <* symbol "|-") <*> (lambdaParser <* symbol ":") <*> try typeParser 

parseIt :: String -> Either ParseError Expression 
parseIt = P.parse expressionParser "" 

test1 = parseIt 
    "|- \\x:Bool -> Nat.\\y:Bool.x y : (Bool -> Nat) -> Bool -> Nat" 
-- 1234 56789.123456789 .123456789. 
--   1   2