在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

看起来你在这里使用Parsec 3，而IndentParser期望Parsec 2.你的例子用-package parsec-2.1.0.1为我编译。

因此IndentParser不一定会被破坏，但作者应该更加具体地说明依赖列表中的版本。 可以安装两个版本的Parsec，因此除非您因为其他原因而决定使用Parsec 3，否则不应该使用IndentParser。

---

更新：实际上不需要对源码进行任何更改以使IdentParser与Parsec 3一起使用。我们双方所遇到的问题似乎是由于cabal-install对Parsec 2有“软偏好”这一事实。你可以简单地使用Parsec版本的显式约束重新安装IndentParser：

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

或者，您可以下载源代码并以正常方式构建和安装 。

Answer 2

这是我为Parsec 3编写的一组解析器组合器，可用于Haskell样式布局，这可能对您有用。 关键的考虑是laidout启动和运行的布局规则，你应该使用space和spaced提供，而不是股票组合子Parsec组合子为了同样的目的。 由于布局和注释的交互，我不得不将注释解析合并到tokenizer中。

{-# 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