parsing - 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

ここではParsec3を使用しているようですが、IndentParserはParsec2を想定しています。例は。でコンパイルされます-package parsec-2.1.0.1。

したがって、IndentParserは必ずしも壊れているわけではありませんが、作成者は依存関係のリスト内のバージョンについてより具体的にする必要があります。両方のバージョンのParsecをインストールすることが可能であるため、他の理由でParsec 3を使用することにコミットしていない限り、IndentParserを使用しない理由はありません。

---

更新：実際には、IdentParserをParsec 3で動作させるためにソースを変更する必要はありません。私たちの両方が抱えていた問題は、Parsec2の「ソフトプリファレンス」cabal-installがあるという事実が原因のようです。 Parsecバージョンに対する明示的な制約：

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

または、ソースをダウンロードして、通常の方法でビルドおよびインストールすることもできます。

Answer 2

これは、Haskellスタイルのレイアウトに使用できるParsec3用にまとめたパーサーコンビネーターのセットです。重要な考慮事項はlaidout、レイアウトルールを開始して実行することと、同じ目的でストックコンビネータではなく提供されspaceているコンビネータを使用する必要があることです。レイアウトとコメントの相互作用のために、コメント解析をトークナイザーにマージする必要がありました。spacedParsec

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