解析Haskell的Parsec中基于缩进的语法

Question

我想在使用Parsec的Haskell中解析基于缩进的语言（认为Python，Haskell本身，Boo，YAML）。我见过IndentParser库，它看起来是完美匹配的，但我无法弄清楚如何将我的TokenParser放入缩进解析器中。下面的代码我到目前为止：

import qualified Text.ParserCombinators.Parsec.Token as T 
import qualified Text.ParserCombinators.Parsec.IndentParser.Token as IT 

lexer = T.makeTokenParser mylangDef 
ident = IT.identifier lexer 

这引发错误：

parser2.hs:29:28: 
    Couldn't match expected type `IT.TokenParser st' 
      against inferred type `T.GenTokenParser s u m' 
    In the first argument of `IT.identifier', namely `lexer' 
    In the expression: IT.identifier lexer 
    In the definition of `ident': ident = IT.identifier lexer 

我在做什么错？我应该如何创建一个IT.TokenParser？或者是IndentParser破碎并且要避免？

Answer 1

它看起来像你使用秒差距3在这里，而IndentParser预计秒差距2.您的示例编译为我-package parsec-2.1.0.1。

所以IndentParser不一定是坏的，但作者应该对依赖关系列表中的版本更具体。可以安装两个版本的Parsec，所以没有理由不应该使用IndentParser，除非您承诺因其他原因使用Parsec 3。

---

UPDATE：其实对于源没有必要改变让IdentParser与我俩都是有秒差距3.问题的工作似乎是一个事实，即cabal-install有秒差距2 "soft preference"引起你可以简单地重新安装IndentParser上的秒差距版本明确的约束：

cabal install IndentParser --reinstall --constraint="parsec >= 3" 

另外，您也可以下载source和build and install in the normal way。

Answer 2

下面是一组解析器组合器，我将Parsec 3放在一起，可用于Haskell样式布局，这可能对您有用。关键考虑事项是laidout启动并运行布局规则，并且您应该使用提供的组合器space和spaced而不是股票Parsec组合器用于相同的目的。由于布局和注释的交互作用，我不得不将注释解析到标记器中。

{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-} 
module Text.Parsec.Layout 
    (laidout   -- repeat a parser in layout, separated by (virtual) semicolons 
    , space   -- consumes one or more spaces, comments, and onside newlines in a layout rule 
    , maybeFollowedBy 
    , spaced   -- (`maybeFollowedBy` space) 
    , LayoutEnv  -- type needed to describe parsers 
    , defaultLayoutEnv -- a fresh layout 
    , semi    -- semicolon or virtual semicolon 
    ) where 

import Control.Applicative ((<$>)) 
import Control.Monad (guard) 

import Data.Char (isSpace) 

import Text.Parsec.Combinator 
import Text.Parsec.Pos 
import Text.Parsec.Prim hiding (State) 
import Text.Parsec.Char hiding (space) 

data LayoutContext = NoLayout | Layout Int deriving (Eq,Ord,Show) 

data LayoutEnv = Env 
    { envLayout :: [LayoutContext] 
    , envBol :: Bool -- if true, must run offside calculation 
    } 

defaultLayoutEnv :: LayoutEnv 
defaultLayoutEnv = Env [] True 

pushContext :: Stream s m c => LayoutContext -> ParsecT s LayoutEnv m() 
pushContext ctx = modifyState $ \env -> env { envLayout = ctx:envLayout env } 

popContext :: Stream s m c => String -> ParsecT s LayoutEnv m() 
popContext loc = do 
    (_:xs) <- envLayout <$> getState 
    modifyState $ \env' -> env' { envLayout = xs } 
    <|> unexpected ("empty context for " ++ loc) 

getIndentation :: Stream s m c => ParsecT s LayoutEnv m Int 
getIndentation = depth . envLayout <$> getState where 
    depth :: [LayoutContext] -> Int 
    depth (Layout n:_) = n 
    depth _ = 0 

pushCurrentContext :: Stream s m c => ParsecT s LayoutEnv m() 
pushCurrentContext = do 
    indent <- getIndentation 
    col <- sourceColumn <$> getPosition 
    pushContext . Layout $ max (indent+1) col 

maybeFollowedBy :: Stream s m c => ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m a 
t `maybeFollowedBy` x = do t' <- t; optional x; return t' 

spaced :: Stream s m Char => ParsecT s LayoutEnv m a -> ParsecT s LayoutEnv m a 
spaced t = t `maybeFollowedBy` space 

data Layout = VSemi | VBrace | Other Char deriving (Eq,Ord,Show) 

-- TODO: Parse C-style #line pragmas out here 
layout :: Stream s m Char => ParsecT s LayoutEnv m Layout 
layout = try $ do 
    bol <- envBol <$> getState 
    whitespace False (cont bol) 
    where 
    cont :: Stream s m Char => Bool -> Bool -> ParsecT s LayoutEnv m Layout 
    cont True = offside 
    cont False = onside 

    -- TODO: Parse nestable {-# LINE ... #-} pragmas in here 
    whitespace :: Stream s m Char => 
     Bool -> (Bool -> ParsecT s LayoutEnv m Layout) -> ParsecT s LayoutEnv m Layout 
    whitespace x k = 
      try (string "{-" >> nested k >>= whitespace True) 
     <|> try comment 
     <|> do newline; whitespace True offside 
     <|> do tab; whitespace True k 
     <|> do (satisfy isSpace <?> "space"); whitespace True k 
     <|> k x 

    comment :: Stream s m Char => ParsecT s LayoutEnv m Layout 
    comment = do 
     string "--" 
     many (satisfy ('\n'/=)) 
     newline 
     whitespace True offside 

    nested :: Stream s m Char => 
     (Bool -> ParsecT s LayoutEnv m Layout) -> 
     ParsecT s LayoutEnv m (Bool -> ParsecT s LayoutEnv m Layout) 
    nested k = 
      try (do string "-}"; return k) 
     <|> try (do string "{-"; k' <- nested k; nested k') 
     <|> do newline; nested offside 
     <|> do anyChar; nested k 

    offside :: Stream s m Char => Bool -> ParsecT s LayoutEnv m Layout 
    offside x = do 
     p <- getPosition 
     pos <- compare (sourceColumn p) <$> getIndentation 
     case pos of 
      LT -> do 
       popContext "the offside rule" 
       modifyState $ \env -> env { envBol = True } 
       return VBrace 
      EQ -> return VSemi 
      GT -> onside x 

    -- we remained onside. 
    -- If we skipped any comments, or moved to a new line and stayed onside, we return a single a ' ', 
    -- otherwise we provide the next char 
    onside :: Stream s m Char => Bool -> ParsecT s LayoutEnv m Layout 
    onside True = return $ Other ' ' 
    onside False = do 
     modifyState $ \env -> env { envBol = False } 
     Other <$> anyChar 

layoutSatisfies :: Stream s m Char => (Layout -> Bool) -> ParsecT s LayoutEnv m() 
layoutSatisfies p = guard . p =<< layout 

virtual_lbrace :: Stream s m Char => ParsecT s LayoutEnv m() 
virtual_lbrace = pushCurrentContext 

virtual_rbrace :: Stream s m Char => ParsecT s LayoutEnv m() 
virtual_rbrace = try (layoutSatisfies (VBrace ==) <?> "outdent") 

-- recognize a run of one or more spaces including onside carriage returns in layout 
space :: Stream s m Char => ParsecT s LayoutEnv m String 
space = do 
    try $ layoutSatisfies (Other ' ' ==) 
    return " " 
    <?> "space" 

-- recognize a semicolon including a virtual semicolon in layout 
semi :: Stream s m Char => ParsecT s LayoutEnv m String 
semi = do 
    try $ layoutSatisfies p 
    return ";" 
    <?> "semi-colon" 
    where 
     p VSemi = True 
     p (Other ';') = True 
     p _ = False 

lbrace :: Stream s m Char => ParsecT s LayoutEnv m String 
lbrace = do 
    char '{' 
    pushContext NoLayout 
    return "{" 

rbrace :: Stream s m Char => ParsecT s LayoutEnv m String 
rbrace = do 
    char '}' 
    popContext "a right brace" 
    return "}" 

laidout :: Stream s m Char => ParsecT s LayoutEnv m a -> ParsecT s LayoutEnv m [a] 
laidout p = try (braced statements) <|> vbraced statements where 
    braced = between (spaced lbrace) (spaced rbrace) 
    vbraced = between (spaced virtual_lbrace) (spaced virtual_rbrace) 
    statements = p `sepBy` spaced semi