Help us understand the problem. What is going on with this article?

Haskellのパーサライブラリまとめ

More than 1 year has passed since last update.

パーサライブラリの現状

Haskellではパーサライブラリは様々なところで使用されています.例えば,Haskellでのデファクト的なJSONパーサライブラリaesonは,JSONデータのパースにattoparsecというライブラリを使用しています.GHCはHaskellプログラムのパースにalex/happyというレクサーとパーサを利用しています.HTTPライブラリでは,parsecを軽量パーサとして使っています.このライブラリでは,WWW-AuthenticateヘッダやSet-Cookieヘッダの内容をparsecでパースしています.

このようにパーサライブラリは非常に需要が高く(文字列をパースするというのは,日常的に出くわす状況ですからね),Haskellでは様々なパーサライブラリが存在します.この記事ではそれらのパーサライブラリの簡単なまとめ と比較 を行います.

さて多くの数があるHaskellのパーサライブラリですが,概ねこれらはパーサコンビネータライブラリです(今回紹介する中では唯一の例外はAlex/Happyであり,その他は全てパーサコンビネータライブラリです).パーサコンビネータライブラリとは,パーサを作るためのいくつかの有用で基本的なパーサとそれらを組み合わせる機構を提供し,そこから数多くのパーサを組み合わせることで最終的なパーサを構築するという方針を持つパーサライブラリのことです.パーサコンビネータライブラリは,パーサをHaskellのデータとして表現していて,コンビネータ(パーサを組み合わせる機構)も単なるHaskellの関数になっています.なので,単なるHaskellプログラムとしてパーサを書けるのが特徴的です.

さてそんなパーサコンビネータライブラリたちですが,多くのライブラリではそれほどコンビネータが異なるわけではなく,パーサもほぼ同じように書くことができます.内部の機構は異なる面が多いですが,インターフェースは同じなのです.そこで,完全に同じインターフェースでパーサを書けるよう,パーサコンビネータ用のクラスと幾つかの基本的なコンビネータを提供するparsersが公開されています.このライブラリのインターフェースを使えば,parsersライブラリに対応しているライブラリならパースを行うことができるわけです.気になる対応状況ですが,現状非公式にparsersライブラリが対応している

  • attoparsec
  • parsec
  • ReadP

などの他に,公式にparsersに対応している

  • trifecta
  • conduit-parse

などがライブラリとして使えます.まあ対応していなくてもApplicativeAlternativeパーサであれば使えるコンビネータなどもあるので,その辺を使っていけるといいですね.なお,似たようなものとしてparser-combinatorsというライブラリがあり,こちらは純正のApplicative/Alternativeパーサ用のコンビネータを提供しています.こちらのライブラリはmegaparsecの作者が作っています.megaparsec自体は諸事情により1,parsersライブラリには対応していません.

パーサコンビネータライブラリとしての古参はparsecです.ただ今となってはparsecはいくつかの問題を抱えており,その速度面の改善を目的としてattoparsecが作られました.attoparsecは主にパース速度に焦点を当てたライブラリですが,それ故にエラーメッセージが非常に見にくいのが難点でした.megaparsecはparsecの比較的新しいフォークで,parsecの全体的な問題解決を目指しています.

ではそれぞれのライブラリの特徴を簡単に紹介していきましょう.

それぞれのパーサライブラリの特徴

Alex

Alexは,レクサー(字句解析器)の1つで,多くの場合Happyとセットで使用されます.lexという有名なレクサーの流れを組むもので,.xという拡張子のファイルに独自の構文を書くことで,字句解析器をHaskellプログラムとして生成してくれます.例えば,次のようなプログラムを書きます.

-- AlexLexerExample.x
{
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# LANGUAGE FlexibleContexts #-}

module AlexLexerExample where

import Control.Monad.State
}

%wrapper "basic"

$digit = 0-9          -- digits
$alpha = [a-zA-Z]     -- alphabetic characters
$extraIdent = [\_ \'] -- extra symbols for variables

tokens :-

  $white+                       { \_ -> White }
  let                           { \_ -> Let }
  in                            { \_ -> In }
  $digit+                       { \s -> (Num $ read s) }
  \(                            { \_ -> LParen }
  \)                            { \_ -> RParen }
  [\=\+\-\*\/]                  { \s -> (Sym s) }
  $alpha [$alpha $digit \_ \']* { \s -> (Var s) }

{
data Token
  = White
  | Let
  | In
  | LParen
  | RParen
  | Sym String
  | Var String
  | Num Int
  | Err
  deriving (Eq, Show)

data LexResult
  = LexError String
  | LexSuccess
  deriving (Eq, Show)

type Stock a = [a] -> [a]

addToken :: MonadState (Stock Token) m => Token -> m ()
addToken token = modify' (\f -> f . (token:))

-- | lex a program
--
-- Tokenize Examples:
-- >>> tokenize str = ($ []) <$> runState (lexProg str) id
-- >>> tokenize "a1 / 5 + a3*(1-a4)"
-- (LexSuccess,[Var "a1",White,Sym "/",White,Num 5,White,Sym "+",White,Var "a3",Sym "*",LParen,Num 1,Sym "-",Var "a4",RParen])
-- >>> tokenize "let x = 1 + let y = 0 in y in 3 + let z = x + 1 in z * 2"
-- (LexSuccess,[Let,White,Var "x",White,Sym "=",White,Num 1,White,Sym "+",White,Let,White,Var "y",White,Sym "=",White,Num 0,White,In,White,Var "y",White,In,White,Num 3,White,Sym "+",White,Let,White,Var "z",White,Sym "=",White,Var "x",White,Sym "+",White,Num 1,White,In,White,Var "z",White,Sym "*",White,Num 2])
-- >>> tokenize "a1 + * a2"
-- (LexSuccess,[Var "a1",White,Sym "+",White,Sym "*",White,Var "a2"])
-- >>> tokenize "y & 3"
-- (LexError "& 3",[Var "y",White])
lexProg :: MonadState (Stock Token) m => String -> m LexResult
lexProg str = go initialInput
  where
    initialInput = ('\n', [], str)

    inputStr (_, _, s) = s

    go input = case alexScan input 0 of
      AlexEOF                  -> return LexSuccess
      AlexError (_, _, rest)   -> return $ LexError rest
      AlexSkip input' _        -> go input'
      AlexToken input' len act -> do
        let token = act $ take len $ inputStr input
        addToken token
        go input'
}

このプログラムをalexコマンドを利用してalex AlexLexerExample.x -o AlexLexerExample.hsとしてやれば,字句解析器が生成されます.またcabalファイルのbuild-toolsフィールドにalexと記述してやれば.xを自動的に変換してコンパイルしてくれます.Alexの詳しい使い方は,Alex User Guideを見ると良いでしょう.

Alex単体ではあまり有用なことはできないため,字句解析した後に強力な解析器を使って字句列をさらにパースするのが普通です.その目的でよく使用されるのがこの後紹介するHappyやEarleyというライブラリです.

Alexは,GHCで字句解析を行うのに使用されていますし,Cabalでも,cabalファイルの字句解析のためにAlexを使用しています.また,プログラミング言語Morteでも字句解析のために,Alexを使用しています.

Happy

Happyは字句列の解析器を生成するライブラリです.Happyはlexとセットでよく使用されているyaccというパーサ生成ツールの流れを組んでいます.Happyのプログラムは,Alexと同じく.yというファイルに独自の構文を書くことで,字句列の解析器をHaskellプログラムとして生成してくれます.例えば,次のようなプログラムを書きます.

-- HappyParserExample.y
{
{-# LANGUAGE DeriveFunctor #-}

module HappyParserExample where
}
%name parseProgram
%tokentype { Token }
%error { parseError }
%monad { Either [Token] } { >>= } { return }

%token
  let             { TokenLet }
  in              { TokenIn }
  num             { TokenNum $$ }
  ident           { TokenVar $$ }
  '='             { TokenSym "=" }
  '+'             { TokenSym "+" }
  '-'             { TokenSym "-" }
  '*'             { TokenSym "*" }
  '/'             { TokenSym "/" }
  '('             { TokenLParen }
  ')'             { TokenRParen }

%right in
%left '+' '-'
%left '*' '/'

%%

program
  :: { AST () }
  : expr                      { AST $1 () }

expr
  :: { Exp () }
  : gen_term(expr, expr)      { $1 }
  | factor                    { $1 }

gen_term(lhs, rhs)
  :: { Exp () }
  : let var '=' lhs in rhs    { LetIn $2 $4 $6 () }
  | lhs '+' rhs               { funApp2 (varExp "+" ()) $1 $3 () }
  | lhs '-' rhs               { funApp2 (varExp "-" ()) $1 $3 () }
  | lhs '*' rhs               { funApp2 (varExp "*" ()) $1 $3 () }
  | lhs '/' rhs               { funApp2 (varExp "/" ()) $1 $3 () }

factor
  :: { Exp () }
  : lit                       { LitExp $1 () }
  | var                       { VarExp $1 () }
  | '(' expr ')'              { $2 }

var
  :: { Var () }
  : ident                     { Var $1 () }

lit
  :: { Lit () }
  : num                       { NumLit $1 () }
{

data Token
  = TokenLet
  | TokenIn
  | TokenNum Int
  | TokenVar String
  | TokenSym String
  | TokenLParen
  | TokenRParen
  deriving (Eq, Show)

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

varExp :: String -> a -> Exp a
varExp v x = VarExp (Var v x) x

funApp2 :: Exp a -> Exp a -> Exp a -> a -> Exp a
funApp2 f e1 e2 x = FunApp (FunApp f e1 x) e2 x

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

parseError :: [Token] -> Either [Token] a
parseError tokens = Left tokens

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
--
-- >>> printGroom $ parseProgram [TokenVar "a1",TokenSym "/",TokenNum 5,TokenSym "+",TokenVar "a3",TokenSym "*",TokenLParen,TokenNum 1,TokenSym "-",TokenVar "a4",TokenRParen]
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram [TokenLet,TokenVar "x",TokenSym "=",TokenNum 1,TokenSym "+",TokenLet,TokenVar "y",TokenSym "=",TokenNum 0,TokenIn,TokenVar "y",TokenIn,TokenNum 3,TokenSym "+",TokenLet,TokenVar "z",TokenSym "=",TokenVar "x",TokenSym "+",TokenNum 1,TokenIn,TokenVar "z",TokenSym "*",TokenNum 2]
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram [TokenVar "a1",TokenSym "+",TokenSym "*",TokenVar "a2"]
-- Left [TokenSym "*",TokenVar "a2"]
-- >>> parseProgram [TokenVar "y",TokenSym "&",TokenVar "3"]
-- Left [TokenSym "&",TokenVar "3"]
parseProgram :: [Token] -> Either [Token] (AST ())
}

このプログラムをhappyコマンドを利用してhappy HappyParserExample.x -o HappyParserExample.hsとしてやれば,解析器が生成されます.またcabalファイルのbuild-toolsフィールドにhappyと記述してやれば.yを自動的に変換してコンパイルしてくれます.Happyの詳しい使い方は,Happy User Guideを見ると良いでしょう.

Happyは,GHCでHaskellプログラムをパースするのに使われています.まずAlexでパースして,その後字句列に対してHappyでパースをします.また,language-rustでもRustプログラムをパースするのにAlex/Happyが使用されています.HappyはBNF記法と対応しやすいため,プログラミング言語など形式的な定義が既に別にありそれと一対一対応をするようなプログラムを書くのに便利です.

Earley

Earleyは,パーサコンビネータライブラリですが,他のパーサコンビネータライブラリと異なることとして,なるべくBNF記法のような一般的な文法に合わせる形でパーサを書けるというのが特徴的なライブラリです.DSL自体は独自の構文ではなくHaskellプログラムそのものですが,文法を合わせるためにRecursiveDo拡張を前提に実装されているのが特徴です.例えば,次のようなプログラムを書きます.

-- EarleyParserExample.hs

{-# LANGUAGE RecursiveDo   #-}
{-# LANGUAGE DeriveFunctor #-}

module EarleyParserExample where

import Control.Applicative
import Text.Earley

type ExampleProd r a = Prod r String Token a

namedShowToken :: (Eq a, Show a) => a -> Prod r String a a
namedShowToken x = token x <?> show x

tokenLet :: ExampleProd r Token
tokenLet = namedShowToken TokenLet

tokenIn :: ExampleProd r Token
tokenIn = namedShowToken TokenIn

num :: ExampleProd r Int
num = numToken <?> "number"
  where
    numToken = terminal $ \t -> case t of
      TokenNum n -> Just n
      _          -> Nothing

ident :: ExampleProd r String
ident = identToken <?> "variable"
  where
    identToken = terminal $ \t -> case t of
      TokenVar s -> Just s
      _          -> Nothing

tokenSym :: String -> ExampleProd r Token
tokenSym sym = namedShowToken (TokenSym sym)

tokenLParen :: ExampleProd r Token
tokenLParen = namedShowToken TokenLParen

tokenRParen :: ExampleProd r Token
tokenRParen = namedShowToken TokenRParen

program :: Grammar r (ExampleProd r (AST ()))
program = mdo
  let expr = expr0
  let expr3 = factor

  expr0 <- rule
    $   funApp2 (varExp "+" ()) <$> expr0 <* tokenSym "+" <*> expr1 <*> pure ()
    <|> funApp2 (varExp "-" ()) <$> expr0 <* tokenSym "-" <*> expr1 <*> pure ()
    <|> expr1

  expr1 <- rule
    $   funApp2 (varExp "*" ()) <$> expr1 <* tokenSym "*" <*> expr2 <*> pure ()
    <|> funApp2 (varExp "/" ()) <$> expr1 <* tokenSym "/" <*> expr2 <*> pure ()
    <|> expr2

  expr2 <- rule
    $   tokenLet *> pure LetIn
        <*> var <* tokenSym "=" <*> expr
        <* tokenIn <*> expr <*> pure ()
    <|> expr3

  factor <- rule
    $   VarExp <$> var <*> pure ()
    <|> LitExp <$> lit <*> pure ()
    <|> tokenLParen *> expr <* tokenRParen

  return $ AST <$> expr <*> pure ()

var :: ExampleProd r (Var ())
var
  = Var <$> ident <*> pure ()

lit :: ExampleProd r (Lit ())
lit
  = NumLit <$> num <*> pure ()

data Token
  = TokenLet
  | TokenIn
  | TokenNum Int
  | TokenVar String
  | TokenSym String
  | TokenLParen
  | TokenRParen
  deriving (Eq, Show)

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

varExp :: String -> a -> Exp a
varExp v x = VarExp (Var v x) x

funApp2 :: Exp a -> Exp a -> Exp a -> a -> Exp a
funApp2 f e1 e2 x = FunApp (FunApp f e1 x) e2 x

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
--
-- >>> printGroom $ parseProgram [TokenVar "a1",TokenSym "/",TokenNum 5,TokenSym "+",TokenVar "a3",TokenSym "*",TokenLParen,TokenNum 1,TokenSym "-",TokenVar "a4",TokenRParen]
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram [TokenLet,TokenVar "x",TokenSym "=",TokenNum 1,TokenSym "+",TokenLet,TokenVar "y",TokenSym "=",TokenNum 0,TokenIn,TokenVar "y",TokenIn,TokenNum 3,TokenSym "+",TokenLet,TokenVar "z",TokenSym "=",TokenVar "x",TokenSym "+",TokenNum 1,TokenIn,TokenVar "z",TokenSym "*",TokenNum 2]
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram [TokenVar "a1",TokenSym "+",TokenSym "*",TokenVar "a2"]
-- Left (Report {position = 2, expected = ["TokenLParen","number","variable","TokenLet"], unconsumed = [TokenSym "*",TokenVar "a2"]})
-- >>> parseProgram [TokenVar "y",TokenSym "&",TokenVar "3"]
-- Left (Report {position = 1, expected = ["TokenSym \"+\"","TokenSym \"-\"","TokenSym \"*\"","TokenSym \"/\""], unconsumed = [TokenSym "&",TokenVar "3"]})
parseProgram :: [Token] -> Either (Report String [Token]) (AST ())
parseProgram tokens = case fullParses (parser program) tokens of
  ([], r)   -> Left r
  (asts, _) -> Right $ last asts

個人的には簡潔でパーサも書きやすいので結構好きなライブラリです.ただ,デバッグがしにくいのと,あまり使われていないようで便利なコンビネータがあまりないのが難点ですね.

このライブラリは名前の通り,パースアルゴリズムにアーリー法の改善版を用いているのが特徴です.作者自身が実装ノートを公開しているため,(まだ記載されてない部分も多いですが)大まかな実装方法を掴むことができます.Parsec系のライブラリと大きく異なるところは,パースできる範囲が有限CFGに限られるところです.なので,文脈依存の文法や無限に大きくなる文法を扱うことはできません.なので,パーサを作成する際は注意して作成しなければいけません.

Earleyに興味があれば,GitHubリポジトリを訪れてみるのが良いでしょう.READMEに簡単な説明がある他,いくつかのexamplesが置いてあります.

Earleyは,プログラミング言語Morteで使用されています.Morteでは,Alexで字句解析をした後,字句列をEarleyのパーサで構文木にします.

Trifecta

Trifectaは,主に速さを保ちつつ,エラーメッセージの改善を目的にしたライブラリです.また,コンビネータをほぼparsersライブラリに丸投げしているのも特徴の一つでしょう.例えば,次のようなプログラムを書きます.

-- TrifectaParserExample.hs

{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFunctor   #-}

module TrifectaParserExample where

import           Control.Applicative
import qualified Data.ByteString.Char8 as BSC
import qualified Data.HashSet as HashSet
import           Text.Parser.Char
import           Text.Parser.Combinators
import           Text.Parser.Expression
import qualified Text.Parser.Token as Tok
import           Text.Parser.Token hiding (reserve, ident)
import qualified Text.Parser.Token.Highlight as Highlight
import           Text.Trifecta.Combinators
import           Text.Trifecta.Delta
import qualified Text.Trifecta.Parser as Trifecta
import qualified Text.Trifecta.Result as Trifecta

type MonadicTokenParsing m =
  ( TokenParsing m
  , CharParsing m
  , Parsing m
  , Monad m
  , Alternative m
  , DeltaParsing m
  )

myIdentStyle :: MonadicTokenParsing m => IdentifierStyle m
myIdentStyle = IdentifierStyle
  { _styleName = "ParserExample"
  , _styleStart = lower <|> oneOf "_"
  , _styleLetter = alphaNum <|> oneOf "_'"
  , _styleReserved = HashSet.fromList
    [ "let", "in"
    ]
  , _styleHighlight = Highlight.Identifier
  , _styleReservedHighlight = Highlight.ReservedIdentifier
  }

identifier :: MonadicTokenParsing m => m String
identifier = Tok.ident myIdentStyle

reserved :: MonadicTokenParsing m => String -> m ()
reserved = Tok.reserve myIdentStyle

attachDelta :: MonadicTokenParsing m => m (Delta -> a) -> m a
attachDelta parser = parser <*> position

num :: MonadicTokenParsing m => m Int
num = fromIntegral <$> integer

program :: MonadicTokenParsing m => m (AST Delta)
program = attachDelta $ AST <$> expr <* eof

expr :: MonadicTokenParsing m => m (Exp Delta)
expr = expr2

expr2 :: MonadicTokenParsing m => m (Exp Delta)
expr2 = buildExpressionParser exprTable expr1
  where
    exprTable =
      [ [ funApp2 (varExp "*") AssocLeft
        , funApp2 (varExp "/") AssocLeft
        ]
      , [ funApp2 (varExp "+") AssocLeft
        , funApp2 (varExp "-") AssocLeft
        ]
      ]

    varExp v = VarExp
      <$> attachDelta (Var <$> symbol v)

    funApp2 = Infix . funApp2'

    funApp2' parser = attachDelta $ do
      f1 <- FunApp <$> attachDelta parser

      let f2 pos x y = FunApp (f1 x pos) y pos
      return f2

expr1 :: MonadicTokenParsing m => m (Exp Delta)
expr1 = attachDelta
  (   reserved "let" *> pure LetIn
      <*> var <* symbol "=" <*> expr
      <* reserved "in" <*> expr
  )
  <|> expr0

expr0 :: MonadicTokenParsing m => m (Exp Delta)
expr0 = factor

factor :: MonadicTokenParsing m => m (Exp Delta)
factor = parens expr <|> attachDelta
  (   VarExp <$> var
  <|> LitExp <$> lit
  )

var :: MonadicTokenParsing m => m (Var Delta)
var = attachDelta
  $    Var <$> identifier

lit :: MonadicTokenParsing m => m (Lit Delta)
lit = attachDelta
  $   NumLit <$> num

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
-- >>> import Text.PrettyPrint.ANSI.Leijen
-- >>> import Text.Trifecta.Result
-- >>> :{
--   parseProgram_ str = case parseProgram str of
--     Success a    -> Right $ fmap (const ()) a
--     Failure info -> Left . show . plain $ _errDoc info
-- :}
--
-- >>> printGroom $ parseProgram_ "a1 / 5 + a3*(1-a4)"
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram_ "let x = 1 + let y = 0 in y in 3 + let z = x + 1 in z * 2"
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram_ "a + * 3"
-- Left "a + * 3:1:5: error: expected: operator\na + * 3<EOF> \n    ^        "
-- >>> parseProgram_ "y & 3"
-- Left "y & 3:1:3: error: expected: \"*\",\n    \"+\", \"-\", \"/\",\n    ambiguous use of a left-associative operator,\n    ambiguous use of a non-associative operator,\n    ambiguous use of a right-associative operator,\n    end of input\ny & 3<EOF> \n  ^        "
parseProgram :: String -> Trifecta.Result (AST Delta)
parseProgram str = Trifecta.parseString program initialDelta str
  where
    initialDelta = Directed (BSC.pack str) 0 0 0 0

Trifectaは大体のコンビネータがparsersライブラリにあり,parsersライブラリのAPIがそのまま使用できます.通常のParsec系と使い勝手も同じなので,それほど難しくはないでしょう.Trifecta自体のドキュメントは(いつものことながら)ほぼ皆無と言っていいですが,parsersライブラリの範疇だけでも恩恵は受けられるので,まずは使って見るのがいいでしょう.

TrifectaはテンプレートレンダリングライブラリEDEでテンプレートをパースするのに使用されています.また,Haskell風のシンタックスを持つプログラミング言語frankでも,プログラムのパースのためにTrifectaを使用しています.

Parsec

ParsecはHaskellの顔と言ってもいいライブラリで,昔から様々なHaskellプログラムで使われています.例えば,次のようなプログラムを書きます.

-- ParsecParserExample.hs

{-# LANGUAGE DeriveFunctor    #-}
{-# LANGUAGE FlexibleContexts #-}

module ParsecParserExample where

import           Control.Applicative
import qualified Text.Parsec as P
import           Text.Parsec (ParsecT, Stream)
import           Text.Parsec.Pos   (SourcePos)
import           Text.Parsec.String (Parser)
import qualified Text.Parsec.Token as P
import           Text.Parsec.Token (GenLanguageDef(..))
import           Text.ParserCombinators.Parsec hiding ((<|>))
import           Text.ParserCombinators.Parsec.Expr

myIdentStyle ::  Stream s m Char => GenLanguageDef s u m
myIdentStyle = LanguageDef
  { commentStart    = ""
  , commentEnd      = ""
  , commentLine     = ""
  , nestedComments  = False
  , identStart      = lower <|> oneOf "_"
  , identLetter     = alphaNum <|> oneOf "_'"
  , opStart         = oneOf "+-*/"
  , opLetter        = oneOf "+-*/"
  , reservedNames   = [ "let", "in" ]
  , reservedOpNames = [ "+", "-", "*", "/", "=" ]
  , caseSensitive   = True
  }

lexer :: Stream s m Char => P.GenTokenParser s u m
lexer = P.makeTokenParser myIdentStyle

identifier :: Stream s m Char => ParsecT s u m String
identifier = P.identifier lexer

reserved :: Stream s m Char => String -> ParsecT s u m ()
reserved = P.reserved lexer

reservedOp :: Stream s m Char => String -> ParsecT s u m ()
reservedOp = P.reservedOp lexer

integer :: Stream s m Char => ParsecT s u m Integer
integer = P.integer lexer

parens :: Stream s m Char => ParsecT s u m a -> ParsecT s u m a
parens = P.parens lexer

symbol :: Stream s m Char => String -> ParsecT s u m String
symbol = P.symbol lexer

num :: Stream s m Char => ParsecT s u m Int
num = fromIntegral <$> integer

attachPos :: (Monad m, Stream s m Char) => ParsecT s u m (SourcePos -> a) -> ParsecT s u m a
attachPos parser = parser <*> getPosition

program :: Parser (AST SourcePos)
program = attachPos $ AST <$> expr <* eof

expr :: Parser (Exp SourcePos)
expr = expr2

expr2 :: Parser (Exp SourcePos)
expr2 = buildExpressionParser exprTable expr1
    where
      exprTable =
        [ [ funApp2 (varExp "*") AssocLeft
          , funApp2 (varExp "/") AssocLeft
          ]
        , [ funApp2 (varExp "+") AssocLeft
          , funApp2 (varExp "-") AssocLeft
          ]
        ]

      varExp v = VarExp
        <$> attachPos (reservedOp v *> pure (Var v))

      funApp2 = Infix . funApp2'

      funApp2' parser = attachPos $ do
        f1 <- FunApp <$> attachPos parser

        let f2 pos x y = FunApp (f1 x pos) y pos
        return f2

expr1 :: Parser (Exp SourcePos)
expr1 = attachPos
  (   reserved "let" *> pure LetIn
      <*> var <* reservedOp "=" <*> expr
      <* reserved "in" <*> expr
  )
  <|> expr0

expr0 :: Parser (Exp SourcePos)
expr0 = factor

factor :: Parser (Exp SourcePos)
factor = parens expr <|> attachPos
  (   VarExp <$> var
  <|> LitExp <$> lit
  )

var :: Parser (Var SourcePos)
var = attachPos
  $    Var <$> identifier

lit :: Parser (Lit SourcePos)
lit = attachPos
  $   NumLit <$> num

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
--
-- >>> :{
--   parseProgram_ str = case parseProgram str of
--     Right a   -> Right $ fmap (const ()) a
--     Left  err -> Left  $ show err
-- :}
--
-- >>> printGroom $ parseProgram_ "a1 / 5 + a3*(1-a4)"
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram_ "let x = 1 + let y = 0 in y in 3 + let z = x + 1 in z * 2"
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram_ "a + * 3"
-- Left "\"direct\" (line 1, column 5):\nunexpected \"*\"\nexpecting \"let\", \"(\", identifier or integer"
-- >>> parseProgram_ "y & 3"
-- Left "\"direct\" (line 1, column 3):\nunexpected '&'\nexpecting operator or end of input"
parseProgram :: String -> Either P.ParseError (AST SourcePos)
parseProgram = P.runParser program () "direct"

Parsecは様々な機能を含んだパーサコンビネータライブラリです.

様々な派生版が存在しますが,Parsec自体もいまだ現役で,様々なところで使用されています.例えば,ShellCheckではシェルスクリプトのパースのためにParsecを使用していますし,HTTPでは一部のHTTPヘッダのパースにParsecを使用しています.また,Cabalでは,Alexで字句解析した後,字句列のパースにParsecを利用しています.Parsecは軽量パーサ,構文パーサ問わず様々なところで使用されているパーサライブラリです.

Attoparsec

Attoparsecは,速さに焦点を当てたParsecの派生ライブラリです.使い勝手はParsecとそう変わりませんが,エラーメッセージが単純化されており,プログラミング言語のパースにはあまり適していないでしょう.例えば,次のようなプログラムを書きます.

-- AttoparsecParserExample.hs

{-# LANGUAGE DeriveFunctor   #-}
{-# LANGUAGE RankNTypes      #-}
{-# LANGUAGE RecordWildCards #-}

module AttoparsecParserExample where

import           Control.Applicative
import           Control.Applicative.Combinators (between)
import qualified Data.Attoparsec.ByteString.Char8 as AttParsec
import           Data.Attoparsec.ByteString.Char8 hiding (string)
import           Data.Attoparsec.Expr
import qualified Data.ByteString.Char8 as BSC
import           Data.Char (isLower, isAlphaNum)
import qualified Data.HashSet as HashSet
import           Data.Semigroup

unexpected :: String -> Parser a
unexpected = fail

notFollowedBy :: Show a => Parser a -> Parser ()
notFollowedBy p = optional p >>= maybe (pure ()) (unexpected . show)

eof :: Parser ()
eof = endOfInput

data LanguageStyle m = LanguageStyle
  { spaceConsumer :: m ()
  , identStart    :: m Char
  , identLetter   :: m Char
  , reservedNames :: HashSet.HashSet String
  }

myLanguageStyle :: LanguageStyle Parser
myLanguageStyle = LanguageStyle
  { spaceConsumer = skipSpace
  , identStart    = satisfy isLower <|> choice (char <$> "_")
  , identLetter   = satisfy isAlphaNum <|> choice (char <$> "_'")
  , reservedNames = HashSet.fromList
    [ "let", "in" ]
  }

data GenTokenParser m = GenTokenParser
  { _lexeme         :: forall a. m a -> m a
  , _isReservedName :: String -> Bool
  , _identifier     :: m String
  , _reserved       :: String -> m ()
  , _symbol         :: String -> m String
  , _integer        :: m Integer
  }

bytestring :: BSC.ByteString -> Parser BSC.ByteString
bytestring = AttParsec.string

string :: String -> Parser String
string str = do
  let bstr = BSC.pack str
  BSC.unpack <$> bytestring bstr

genTokenParser :: LanguageStyle Parser -> GenTokenParser Parser
genTokenParser LanguageStyle{..} = GenTokenParser
    { _lexeme         = glexeme
    , _isReservedName = gisReservedName
    , _identifier     = gidentifier
    , _reserved       = greserved
    , _symbol         = gsymbol
    , _integer        = ginteger
    }
  where
    glexeme parser = parser <* spaceConsumer

    gisReservedName name = HashSet.member name reservedNames

    gidentifier = glexeme $ try $ do
      name <- ident
      if gisReservedName name
        then unexpected $ "reserved word " <> show name
        else return name

    ident = do
      c  <- identStart
      cs <- many identLetter
      return $ c:cs

    greserved name = glexeme $ try $ do
      _ <- string name
      notFollowedBy identLetter <?> "end of " <> name

    gsymbol = glexeme . try . string

    ginteger = glexeme $ try decimal

lexer :: GenTokenParser Parser
lexer = genTokenParser myLanguageStyle

lexeme :: Parser a -> Parser a
lexeme = _lexeme lexer

identifier :: Parser String
identifier = _identifier lexer

reserved :: String -> Parser ()
reserved = _reserved lexer

symbol :: String -> Parser String
symbol = _symbol lexer

integer :: Parser Integer
integer = _integer lexer

num :: Parser Int
num = fromIntegral <$> integer

parens :: Parser a -> Parser a
parens = between (symbol "(") (symbol ")")

program :: Parser (AST ())
program = AST <$> expr <*> pure () <* eof

expr :: Parser (Exp ())
expr = expr2

expr2 :: Parser (Exp ())
expr2 = buildExpressionParser exprTable expr1
  where
    exprTable =
      [ [ funApp2 (varExp "*") AssocLeft
        , funApp2 (varExp "/") AssocLeft
        ]
      , [ funApp2 (varExp "+") AssocLeft
        , funApp2 (varExp "-") AssocLeft
        ]
      ]

    varExp v = VarExp
      <$> (Var <$> symbol v <*> pure ())

    funApp2 = Infix . funApp2'

    funApp2' parser = pure () <**> do
      f1 <- FunApp <$> (parser <*> pure ())

      let f2 z x y = FunApp (f1 x z) y z
      return f2

expr1 :: Parser (Exp ())
expr1 = pure () <**>
  (   reserved "let" *> pure LetIn
      <*> var <* symbol "=" <*> expr
      <* reserved "in" <*> expr
  ) <|> expr0

expr0 :: Parser (Exp ())
expr0 = factor

factor :: Parser (Exp ())
factor = parens expr <|>
  (   VarExp <$> var
  <|> LitExp <$> lit
  ) <*> pure ()

var :: Parser (Var ())
var
  = Var <$> identifier <*> pure ()

lit :: Parser (Lit ())
lit
  = NumLit <$> num <*> pure ()

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
--
-- >>> printGroom $ parseProgram "a1 / 5 + a3*(1-a4)"
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram "let x = 1 + let y = 0 in y in 3 + let z = x + 1 in z * 2"
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram "a + * 3"
-- Left "endOfInput"
-- >>> parseProgram "y & 3"
-- Left "endOfInput"
parseProgram :: String -> Either String (AST ())
parseProgram = parseOnly program . BSC.pack

なお上のコードではattoparsec-exprという補助ライブラリも使用しています.ここからも様々な機能を提供している本家のParsecとは少々異なることがわかります.Attoparsecは,速さが大事な汎用データのパースによく使用されています.エラーメッセージは少し工夫しないととても不親切になりますが,Haskellのパーサライブラリの中では最速の汎用パーサライブラリです.なお,ポジションなども取れないためエラーメッセージやストリーム対応などを行う場合,ある程度を諦めるか自分でそのような機構を作るかする必要があります2.その場合は素直に他のライブラリを使った方がいいでしょう.

Attoparsecは本家Parsecに負けず劣らず様々なHaskellライブラリで使用されています.Haskellのデファクトと言ってよいJSONライブラリaesonではJSONをパースするのに使用されていますし,ビルドツールstackでは軽量パーサとして様々なもののパーサをAttoparsecを使用して書いています.

Megaparsec

Megaparsecは,Parsecの全体的な改善を目指したフォークライブラリです.使い勝手もParsecとそう変わりません.ただ,Parsecより少し機能が劣る場面もあるでしょう.例えば,次のようなプログラムを書きます.

-- MegaparsecParserExample.hs

{-# LANGUAGE ConstraintKinds   #-}
{-# LANGUAGE DeriveFunctor     #-}
{-# LANGUAGE TypeFamilies      #-}

module MegaparsecParserExample where

import           Control.Applicative
import           Control.Applicative.Combinators
import           Data.Char                  (isAlphaNum)
import qualified Data.HashSet               as HashSet
import           Data.Semigroup
import qualified Data.Set                   as Set
import qualified Text.Megaparsec            as P
import           Text.Megaparsec            (MonadParsec, (<?>))
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as PL
import           Text.Megaparsec.Pos        (SourcePos)
import           Text.Megaparsec.Expr

type MonadCharParsec e s m =
  ( Ord e
  , MonadParsec e s m
  , P.Token s ~ Char
  , P.Tokens s ~ String
  )

data LanguageStyle m = LanguageStyle
  { spaceConsumer :: m ()
  , identStart    :: m Char
  , identLetter   :: m Char
  , reservedNames :: HashSet.HashSet String
  }

myLanguageStyle :: MonadCharParsec e s m => LanguageStyle m
myLanguageStyle = LanguageStyle
  { spaceConsumer = space
  , identStart    = lowerChar <|> oneOf "_"
  , identLetter   = satisfy isAlphaNum <|> oneOf "_'"
  , reservedNames = HashSet.fromList
    [ "let", "in" ]
  }

isReservedName :: String -> LanguageStyle m -> Bool
isReservedName name langStyle = HashSet.member name $ reservedNames langStyle

unexpected :: (Ord e, MonadParsec e s m) => String -> m a
unexpected msg = P.fancyFailure $ Set.fromList
  [ P.ErrorFail msg
  ]

gidentifier :: MonadCharParsec e s m => LanguageStyle m -> m String
gidentifier langStyle = lexeme $ P.try $ do
    name <- ident
    if isReservedName name langStyle
      then unexpected $ "reserved word " <> show name
      else return name
  where
    ident = do
      c  <- identStart langStyle
      cs <- many (identLetter langStyle)
      return $ c:cs

identifier :: MonadCharParsec e s m => m String
identifier = gidentifier myLanguageStyle

greserved :: MonadCharParsec e s m => LanguageStyle m -> String -> m ()
greserved langStyle name = lexeme $ P.try $ do
  _ <- string name
  P.notFollowedBy (identLetter langStyle) <?> "end of " ++ name

reserved :: MonadCharParsec e s m => String -> m ()
reserved = greserved myLanguageStyle

glexeme :: MonadCharParsec e s m => LanguageStyle m -> m a -> m a
glexeme langStyle = PL.lexeme $ spaceConsumer langStyle

lexeme :: MonadCharParsec e s m => m a -> m a
lexeme = glexeme myLanguageStyle

symbol :: MonadCharParsec e s m => String -> m String
symbol = PL.symbol $ spaceConsumer myLanguageStyle

num :: MonadCharParsec e s m => m Int
num = lexeme PL.decimal

parens :: MonadCharParsec e s m => m a -> m a
parens = between (symbol "(") (symbol ")")

attachPos :: MonadParsec e s m => m (SourcePos -> a) -> m a
attachPos parser = parser <*> P.getPosition

program :: MonadCharParsec e s m => m (AST SourcePos)
program = attachPos $ AST <$> expr <* P.eof

expr :: MonadCharParsec e s m => m (Exp SourcePos)
expr = expr2

expr2 :: MonadCharParsec e s m => m (Exp SourcePos)
expr2 = makeExprParser expr1 exprTable
  where
    exprTable =
      [ [ funApp2 $ varExp "*"
        , funApp2 $ varExp "/"
        ]
      , [ funApp2 $ varExp "+"
        , funApp2 $ varExp "-"
        ]
      ]

    varExp v = VarExp
      <$> attachPos (Var <$> symbol v)

    funApp2 = InfixL . funApp2'

    funApp2' parser = attachPos $ do
      f1 <- FunApp <$> attachPos parser

      let f2 pos x y = FunApp (f1 x pos) y pos
      return f2

expr1 :: MonadCharParsec e s m => m (Exp SourcePos)
expr1 = attachPos
  (   reserved "let" *> pure LetIn
      <*> var <* symbol "=" <*> expr
      <* reserved "in" <*> expr
  )
  <|> expr0

expr0 :: MonadCharParsec e s m => m (Exp SourcePos)
expr0 = factor

factor :: MonadCharParsec e s m => m (Exp SourcePos)
factor = parens expr <|> attachPos
  (   VarExp <$> var
  <|> LitExp <$> lit
  )

var :: MonadCharParsec e s m => m (Var SourcePos)
var = attachPos
  $    Var <$> identifier

lit :: MonadCharParsec e s m => m (Lit SourcePos)
lit = attachPos
  $   NumLit <$> num

data AST a = AST (Exp a) a
  deriving (Eq, Show, Functor)

data Exp a
  = LetIn (Var a) (Exp a) (Exp a) a
  | FunApp (Exp a) (Exp a) a
  | LitExp (Lit a) a
  | VarExp (Var a) a
  deriving (Eq, Show, Functor)

data Var a = Var String a
  deriving (Eq, Show, Functor)

data Lit a = NumLit Int a
  deriving (Eq, Show, Functor)

-- | parse a program
--
-- Parse Examples:
-- >>> import Text.Groom
-- >>> printGroom = putStrLn . groom
--
-- >>> :{
--   parseProgram_ str = case parseProgram str of
--     Right a   -> Right $ fmap (const ()) a
--     Left  err -> Left  $ show err
-- :}
--
-- >>> printGroom $ parseProgram_ "a1 / 5 + a3*(1-a4)"
-- Right
--   (AST
--      (FunApp
--         (FunApp (VarExp (Var "+" ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "/" ()) ()) (VarExp (Var "a1" ()) ()) ())
--               (LitExp (NumLit 5 ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "a3" ()) ()) ())
--            (FunApp
--               (FunApp (VarExp (Var "-" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--               (VarExp (Var "a4" ()) ())
--               ())
--            ())
--         ())
--      ())
-- >>> printGroom $ parseProgram_ "let x = 1 + let y = 0 in y in 3 + let z = x + 1 in z * 2"
-- Right
--   (AST
--      (LetIn (Var "x" ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 1 ()) ()) ())
--            (LetIn (Var "y" ()) (LitExp (NumLit 0 ()) ())
--               (VarExp (Var "y" ()) ())
--               ())
--            ())
--         (FunApp
--            (FunApp (VarExp (Var "+" ()) ()) (LitExp (NumLit 3 ()) ()) ())
--            (LetIn (Var "z" ())
--               (FunApp
--                  (FunApp (VarExp (Var "+" ()) ()) (VarExp (Var "x" ()) ()) ())
--                  (LitExp (NumLit 1 ()) ())
--                  ())
--               (FunApp
--                  (FunApp (VarExp (Var "*" ()) ()) (VarExp (Var "z" ()) ()) ())
--                  (LitExp (NumLit 2 ()) ())
--                  ())
--               ())
--            ())
--         ())
--      ())
-- >>> parseProgram_ "a + * 3"
-- Left "TrivialError (SourcePos {sourceName = \"direct\", sourceLine = Pos 1, sourceColumn = Pos 5} :| []) (Just (Tokens ('*' :| \" 3\"))) (fromList [Tokens ('(' :| \"\"),Tokens ('l' :| \"et\"),Label ('i' :| \"nteger\"),Label ('l' :| \"owercase letter\"),Label ('w' :| \"hite space\")])"
-- >>> parseProgram_ "y & 3"
-- Left "TrivialError (SourcePos {sourceName = \"direct\", sourceLine = Pos 1, sourceColumn = Pos 3} :| []) (Just (Tokens ('&' :| \"\"))) (fromList [Label ('o' :| \"perator\"),Label ('w' :| \"hite space\"),EndOfInput])"
parseProgram :: Ord e => String -> Either (P.ParseError Char e) (AST SourcePos)
parseProgram = P.runParser program "direct"

Megaparsecの売りはParsecの全面的な改善で,より良いドキュメント化,より良いテスト,より良いエラー,より速いパーサを目指しています.ただ,ParsecのAPIを少し変えているため,完全にParsecそのものと同様に使えるわけではありません.

Megaparsecは,プログラミング言語Idrisでプログラムのパースのために使用されています.また,HaskellのDotEnvライブラリでも,dotenvファイルをパースするのに使用されています.今後多くの場面で,Parsecに変わって使用されるようになるかもしれません.

最後に

比較までしたかったけど,ちょっと暇がなかった.

というわけで,Haskellで有名どころのパーサライブラリまとめでした.他にもHaXmlで使われている軽量パーサライブラリpolyparseなどがあります.興味があれば探してみてください.

参考資料


  1. megaparsecが対応していない理由は, https://github.com/mrkkrp/megaparsec#megaparsec-vs-parsers にあります.僕からはノーコメントで. 

  2. conduit-extraはこの機構を独自に作っており,色々苦労しているようです.もし,あなたが独自機構を作って何かしたい場合があるなら,参考にしてみるといいでしょう. 

Why not register and get more from Qiita?
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away
Comments
Sign up for free and join this conversation.
If you already have a Qiita account
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
  1. We will deliver articles that match you
    By following users and tags, you can catch up information on technical fields that you are interested in as a whole
  2. you can read useful information later efficiently
    By "stocking" the articles you like, you can search right away