PureScriptでパーサーコンビネータを触る (2) テキストファイル

December 31, 2021

(last modified:

December 31, 2021

)

tags:

parser

categories:

前回の記事と合わせて1つの記事にする予定だったが、前回があまりに長くなってしまったので分割した。

ある書式に従ったテキストファイルをパースすることを考える。パースしたデータを整形し、HTML文書として出力するところまでやる。

前回インポートした関数で今回使うものは、(漏れが無ければ)以下の通り。

import Control.Alt ((<|>))
import Control.Lazy (defer)
import Text.Parsing.Parser (Parser, fail)
import Text.Parsing.Parser.String (char)

テキストの仕様

テキストファイルは、複数のentryで構成される。
1つのentryはタイトルtitleと中身bodyで構成される。
titleは[と]でくくられる。
titleとbodyの間、bodyと次のentryのtitleの間には、1つの改行と、0個以上の空行があり得る。それらはbodyには含まない。
空行とは、0個以上のスペースだけから構成される行のことである。

BNF風に書くと次のようになるだろう。

    <entries> = (0個以上の<entry>)
      <entry> = <title> "\n" <empty lines> <body> "\n" <empty lines>
      <title> = "["  (文字列)  "]"
       <body> = (先頭、末尾が<empty lines>でないような文字列)
<empty lines> = (0個以上の<empty line>)
 <empty line> = (0個以上のスペース) "\n"

例えば、以下のファイルがあったとする。

[Title1]
line1
line2
line3
line4


[Title2]


line1
line2
[Title3]

line1

line2


line3

これは次のようにパースされる。

[ { title: "Title1", body: "line1\nline2\nline3\nline4" }
, { title: "Title2", body: "line1\nline2" }
, { title: "Title3", body: "line1\n\nline2\n\nline3" }
]

以下では、title、body、entryの順にパーサーを作成していく。

titleのパース

[<text>]の形の文字列をパースし、<text>の部分を取得するパーサーを作成する。素朴には以下のように書けそうだ。

import Data.Array as Array
import Data.String.CodeUnits as String
import Text.Parsing.Parser.String (anyChar)

title :: Parser String String
title = String.fromCharArray <$>
  (char '[' *> (Array.many anyChar) <* char ']')

ところが、パースは成功しない。

> runParser "[Title]" title
(Left (ParseError "Expected ']'" (Position { line: 1, column: 8 })))

というのも、Array.manny anyCharは任意の文字を0回以上受け入れてしまうため、その中で]もパースされてしまうからだ。

そのため、anyCharの代わりに、「]以外の文字にマッチするパーサー」を定義すればうまくいく。

import Text.Parsing.Parser.String (satisfy)


title :: Parser String String
title = String.fromCharArray <$>
  (char '[' *> (Array.many titleChar) <* char ']')


titleChar :: Parser String Char
titleChar = satisfy (_ /= ']')

bodyのパース

1つのentryに対して、bodyの終わりを判定するにはどうすればよいのか。もし読み取り中に[<text>]の文字列を発見したら、次のentryに入ったことになるので、これが終了点になるだろう。また、ファイルの終端もentryの終了条件となる。以上のことから、次の手順でbodyをパースしていくことを考える。

先頭の空行を読み飛ばす。
title、もしくはEOFが来るまでパースし続ける。
最後の空行はData.String.UtilsのtrimEnd関数で取り除く。

trimEndを使うために、パッケージpurescript-stringutilsをインストール。

% spago install stringutils

そのために、まずは空行のパーサーを作成する。

空行のパース

準備として改行を読み取るパーサーを作成する。LFとCRLFの2パターンに対応させておく。

newline :: Parser String String
newline = do
  c <- anyChar
  case c of
    '\n' ->
      pure "\n"

    '\r' ->
      satisfy (_ == '\n') *> pure "\r\n"

    _ ->
      fail "newline"

続いて、空行のパーサーを作成する。今回は、スペースだけが含まれている行も空行とみなす。そこで、空行かどうかを判定するためには、「改行が現れるまでスペースを取り除く」という処理を行えば良い。

これはパーサーの視点に立ってみると、

まずnewlineのパースを試みる。成功したらパース終了。
newlineのパースに失敗した場合、スペースのパースを試みる。成功したら1に戻る。

という手順を踏む。これは再帰的なパーサーとなる。

コードにすると以下の通り。Applicative styleにするとscan関数にdeferをつけなくてはいけないのは少し残念なところ。なお、Text.Parsing.Parser.StringにwhiteSpaceという関数があるが、これはスペースだけでなく改行文字もパースしてしまうのでここでは使えない。また配列の結合に(:)を使っているが、この計算量に注意。もし効率を重視したいなら、ArrayではなくListを使えば良い。

sp :: Parser String Char
sp = satisfy (_ == ' ')

emptyLine :: Parser String String
emptyLine = String.fromCharArray <$> scan
  where
    scan = defer \_ ->
       ([] <$ newline) <|> ((:) <$> sp <*> scan)

実はこれは期待通りに動作しない。パースが成功してほしいところでエラーが返ってくる。

> runParser "      \n" emptyLine
(Left (ParseError "newline" (Position { line: 1, column: 2 })))

これは、以下のParsecを使ったHaskellのコードでも期待通りに動作しない。

type Parser s = Parsec s ()

newline :: Parser String String
newline = do
  c <- anyChar
  case c of
    '\n' ->
      pure "\n"

    '\r' ->
      satisfy (== '\n') *> pure "\r\n"

    _ ->
      fail "newline"

sp :: Parser String Char
sp = satisfy (== ' ')

emptyLine :: Parser String String
emptyLine = ([] <$ newline) <|> ((:) <$> sp <*> emptyLine)

これは、newlineが文字列を消費してしまうからである。実際、Parsecの<|>のドキュメントを読んでみると、

If p fails without consuming any input, parser q is tried.

と書かれている。これはpurescript-parsingでも同じである (Alt型クラス実装のソースコードを見て分かった。しかしドキュメントの記載は見当たらず)。

文字列を消費しないようにするためには、try関数を用いれば良い。 try関数のドキュメントにも、<|>との併用について詳しく説明されている。

import Text.Parsing.Parser.Combinators (try)


newline :: Parser String String
newline = try do -- tryを追加
  -- 略


emptyLine :: Parser String String
emptyLine = String.fromCharArray <$> scan
  where
    scan = defer \_ ->
       ([] <$ newline) <|> ((:) <$> sp <*> scan)

> runParser "   \n" emptyLine
(Right "   ")

ちなみにfix関数を使うと、以下のように無名関数で再帰できる。fixで指定する関数の引数selfが、その関数自身を指している。この場合deferをつけなくて済む。

import Control.Lazy (fix)

emptyLine :: Parser String String
emptyLine = String.fromCharArray <$> fix \self ->
       ([] <$ newline) <|> ((:) <$> sp <*> self)

実はこのような、「改行が現れるまでスペースのパースを続ける」という処理は、manyTillというパーサーで実現できる。実装は上の場合とほとんど同じだが、効率面の理由でArrayではなくListを使って実装されている。

パース結果はList Charで返ってくるため、Data.Array.toFoldableで配列に変換し、String.fromCharArrayで文字列に変換する。

listToString :: List Char -> String
listToString = String.fromCharArray <<< Array.fromFoldable

emptyLine :: Parser String String
emptyLine = try $ listToString <$>
   manyTill sp newline

bodyのパース

まず、titleの後には必ず改行が来るものとする。そのためにtitleLineを定義。

titleLine :: Parser String String
titleLine = title <* newline

bodyの終了はタイトルまたはEOFとしたいから、そのためのパーサーを作成。

import Text.Parsing.Parser.String (eof)


bodyEnd :: Parser String Unit
bodyEnd = try $ (unit <$ titleLine)  <|> eof

以上を踏まえて、bodyパーサーを作成する。空行をskipManyで読み飛ばし、bodyEndが来るまで文字列を読み取る。最後にString.trimEndで末尾の空行を削除している。

import Data.String.Utils (trimEnd) as String
import Text.Parsing.Parser.Combinators (skipMany)


body :: Parser String String
body = String.trimEnd <<< listToString <$> do
  skipMany emptyLine
  manyTill anyChar bodyEnd

> runParser "\n\n   aaa\n\nbbb\ncc" body
(Right "aaa\n\nbbb\ncc")

> runParser "\n\n   aaa\n\nbbb\ncc[title]\n" body
(Right "aaa\n\nbbb\ncc")

entryのパース

以上の道具立てで、entryをパースする。

type Entry =
  { title :: String
  , body :: String
  }


entry :: Parser String Entry
entry = do
  t <- title
  b <- body
  pure { title: t, body: b }

> runParser "[title]\n\nline1\n\nline2\nline3\n\n\n\n" entry
(Right { body: "line1\n\nline2\nline3\n\n\n\n[title2]", title: "title" })

> runParser "[title]\n\nline1\n\nline2\nline3\n\n\n\n[title2]\n" entry
(Right { body: "line1\n\nline2\nline3", title: "title" })

manyTillの問題点とその解決

現在のentryは、期待した動作にならない。実際、以下のように複数のentryが入ったテキストをパースしてみる。

> runParser "[title1]\nline1\nline2\n[title2]\nline1\nline2" (Array.many entry)
(Right [{ body: "line1\nline2", title: "title1" }])

本来なら、以下のように2つのentryが返ってきて欲しい。

(Right [{ body: "line1\nline2", title: "title1" }
       ,{ body: "line1\nline2", title: "title2" }])

期待通りに動作しない理由は、bodyパーサーで使っているmanyTillにある。この問題をみるために、次のパーサーを定義する。これは、パースの結果だけでなく、まだ消費していない文字列も返すパーサーである。 ParserはStateTを使って実装されているため、Parserの状態を取得するためにはgetを使えば良い。

import Control.Monad.State.Class (get)
import Text.Parsing.Parser (ParseState)


verbose :: forall s a. Parser s a -> Parser s { result :: a, remain :: s }
verbose p = do
    result <- p
    ParseState remain _ _ <- get
    pure { result, remain }

これを用いて先程のentryをパースしてみると、[title2]がremainに残っていないことが確認できる。つまり、entryによって残って欲しい[title2]が消費されてしまったのだ。

> runParser "[title1]\nline1\nline2\n[title2]\nline1\nline2" (verbose entry)
(Right { remain: "line1\nline2", result: { body: "line1\nline2", title: "title1" } })

実は、bodyパーサーのmanyTill anyChar bodyEndの部分に問題がある。例えば以下のようなパースを実行すると、manyTill p endのendの部分が消費されていることが分かる。今回の目的としては、endの部分は消費されてほしくない。

> runParser "aaabbbccc" $ verbose (manyTill anyChar (string "bbb"))
(Right { remain: "ccc", result: ('a' : 'a' : 'a' : Nil) })

そこで、manyTill p endのendが消費されないようなパーサーを作る必要がある。この関数を、今回はmanyTill_という名前にする。消費されないようにするためには、lookAheadを使う。

import Text.Parsing.Parser.Combinators (lookAhead)


manyTill_ :: forall s a b. Parser s a -> Parser s b -> Parser s (List a)
manyTill_ p end = scan
  where
    scan = defer \_ ->
      (Nil <$ lookAhead end) <|> (Cons <$> p <*> scan)

これでちゃんとendが消費されなくなる。

> runParser "aaabbbccc" $ verbose (manyTill_ anyChar (string "bbb"))
(Right { remain: "bbbccc", result: ('a' : 'a' : 'a' : Nil) })

それではbodyパーサーを修正する。manyTillをmanyTill_に置き換える。

body :: Parser String String
body = String.trimEnd <<< listToString <$> do
  skipMany emptyLine
  manyTill_ anyChar bodyEnd

> runParser "[title1]\nline1\nline2\n[title2]\nline1\nline2" (Array.many entry)
(Right [{ body: "line1\nline2", title: "title1" },{ body: "line1\nline2", title: "title2" }])

標準入力から読み取る

nodeの機能を使う。標準入力からの読み取りに関連するライブラリをインストール。

% spago install node-streams node-process node-buffer refs

stdinからの読み取りを行う。nodeの関数をそのままラッピングしているようで、以下のようにコールバック関数を使って処理を書く必要がある。 onDataStringは文字列が送られてきたとき、onEndは読み取りが終了したときに発生するイベント。やってきた文字列をrefに連結していく。

とりあえずここでは、単に入力した文字列をパースするだけとする。

import Effect.Ref as Ref
import Node.Stream as NS
import Node.Process (stdin)
import Node.Encoding (Encoding(..))


onEndInput :: String -> Effect Unit
onEndInput input =
  log $ show $ runParser input (Array.many entry)

main :: Effect Unit
main = do
  ref <- Ref.new ""
  NS.onDataString stdin UTF8 \s ->
    Ref.modify_ (_ <> s) ref

  NS.onEnd stdin do
    s <- Ref.read ref
    onEndInput s

次のようなテキストファイルを作り、sample.txtとして保存する。

[Title1]
line1
line2
line3
line4


[Title2]


line1
line2
[Title3]

line1

line2


line3

実行してみると、正しくテキストファイルがパースされていることが確認できる (見やすいように改行してある)。

% spago run < sample.txt

(Right [{ body: "line1\nline2\nline3\nline4", title: "Title1" }
       ,{ body: "line1\nline2", title: "Title2" }
       ,{ body: "line1\n\nline2\n\n\nline3", title: "Title3" }])

(おまけ) HTML文書への変換

せっかくなので、データをHTML文書に書き起こしてみる。変換の仕様は以下の通り。

1つのentryはdivで括る
titleはh1タグで括る
bodyはpreタグで括る

まず簡単にHTML要素のデータ型を作成する。

data HTMLElem
  = Div (Array HTMLElem)
  | Pre String
  | H1 String


instance Show HTMLElem where
  show (Div elems) =
    "<div>\n" <> (Array.intercalate "" $ map show elems) <> "</div>\n"
  show (Pre text) =
    "<pre>" <> text <> "</pre>\n"
  show (H1 text) =
    "<h1>" <> text <> "</h1>\n"

1つのentryをHTMLに変換する関数を作成。

entryToHTML :: Entry -> HTMLElem
entryToHTML { title, body } =
  Div
    [ H1 title
    , Pre body
    ]

最後に、onEndInputを修正する。entryをHTMLに変換し、それをlogで出力。

onEndInput :: String -> Effect Unit
onEndInput input =
  case runParser input (Array.many entry) of
    Right entries ->
      logShow $ Div (map entryToHTML entries)

    Left e ->
      logShow e

これでspago run < sample.txtを実行すると、以下のHTMLが出力される。

<div>
<div>
<h1>Title1</h1>
<pre>line1
line2
line3
line4</pre>
</div>
<div>
<h1>Title2</h1>
<pre>line1
line2</pre>
</div>
<div>
<h1>Title3</h1>
<pre>line1

line2


line3</pre>
</div>
</div>

(おまけ) パーサーコンビネータを使わない方法

今回みるべきは行ごとである。このような、行に分けられる書式のデータについては、lines関数で切り出して1行ずつ見ていく手法の方が、実は手軽だったりしないのか。そこで、パーサーコンビネータを(ほぼ)使わずに、テキストファイルのパーサーを実装してみた。

結果として、「ここにはtryを入れなくてはいけない」みたいなハマりポイントは無く実装できたが、再帰関数をどう実装するか、どんな手順でパースしていけばよいのか、どう機能を分割すれば見通しの良いコードが書けるかなどでかなり時間を使った。

結局、以下の手順でパースすることで落ち着いた。

Data.String.Utilsのlines関数で、テキストを行ごとに分割。
再帰関数で実装する。関数の引数に、(暫定entry, 未消費の行)を持たせる。
未消費の行から1つ取って、それがタイトルなのか、そうでないのかを調べる。
- もしタイトルなら、次のentryに入ったということなので、暫定だったentry
- そうでないなら、それを暫定entryのbody部にくっつける。
titleとbodyの間の空行は読み飛ばす。bodyと次のtitleの間の空行は、後でString.trimEndで取り除く。

別ファイルを作ってコードを書く。ファイルはsrc/LineParser.pursとでもしておく。

天下り的だが、以下の文を先頭に書く。

module LineParser where

import Prelude

import Text.Parsing.Parser (Parser, runParser)
import Text.Parsing.Parser.String (char, satisfy)
import Data.String.CodeUnits (fromCharArray, toCharArray) as String
import Data.String.Utils (lines, trimEnd) as String
import Data.Array as Array
import Data.List as List
import Data.List (List(..))
import Data.Either (isRight) as Either
import Data.Maybe (Maybe(..))

行の種類を判別する関数

titleか否かを判別する関数を作る。これに関してはText.Parsing.ParserのParserを使わせてもらう。

parserTitle :: Parser String String
parserTitle = String.fromCharArray <$>
  (char '[' *> (Array.many $ satisfy (_ /= ']')) <* char ']')

isTitle :: String -> Boolean
isTitle text = Either.isRight $ runParser text parserTitle

空行を取り除く関数

空行を取り除く関数dropEmptyLinesを作成。

allSpaces :: String -> Boolean
allSpaces = Array.all (_ == ' ') <<< String.toCharArray


dropEmptyLines :: List String -> List String
dropEmptyLines = List.dropWhile allSpaces

Entryとそれを操作するユーティリティ関数

titleだけ入ったentryを作成する関数。bodyに追記する関数、bodyの末尾の空行を取り除く関数を作成する。

type Entry =
  { title :: String
  , body :: String
  }


newEntry :: String ->  Entry
newEntry newTitle =
  { title: newTitle, body: "" }


appendBody :: String -> Entry -> Entry
appendBody line entry = 
  case entry.body of
    "" ->
        entry { body = line }

    _ ->
        entry { body = entry.body <> "\n" <> line }
        
trimBodyEnd :: Entry -> Entry
trimBodyEnd entry =
  entry { body = String.trimEnd entry.body }

再帰関数

テキスト中に初めて現れるtitleを見つける関数findFirstTitleを作成。これを用いて、本命のparseEntriesを作成。

findFirstTitle :: List String -> Maybe { title :: String, rest :: List String }
findFirstTitle Nil = Nothing
findFirstTitle (Cons x xs) =
  if isTitle x then
    Just { title: x, rest: xs }
  else
    findFirstTitle xs


parseEntries :: String -> Array Entry
parseEntries text =
  case findFirstTitle allLines of
    Nothing ->
      []

    Just { title, rest } ->
      Array.fromFoldable $ map trimBodyEnd $ scan { title, body: "" } rest
  where
    allLines :: List String
    allLines = Array.toUnfoldable $ String.lines text 

    scan :: Entry -> List String -> List Entry
    scan entry Nil = Cons entry Nil
    scan entry (Cons line lines) =
      if isTitle line then
        Cons entry $
             scan (newEntry line)
                  (dropEmptyLines lines)
      else
        scan (appendBody line entry) lines

parseEntriesのコード量がだいぶ大きくなってしまった(自分の力量不足もある)。 parseEntriesが何をやっているのかについて、パッとみて分かるとは言いづらい。

テキストファイルのパース

src/Main.pursに戻り、onEndInputを次のようにすれば、作ったパーサーが動くことが確かめられる。

import LineParser (parseEntries)


onEndInput :: String -> Effect Unit
onEndInput input = 
  log $ show $ Div (map entryToHTML $ parseEntries input)

まとめ・感想

skipMany、lookAhead、manyTillなど、色々なパーサーを使うことができた。またtryがどんなところが役に立つのかを知ることができた。

Parserの内部状態を取得するにはgetを使えば良いという点については、個人的に盲点だった。

パーサーコンビネータを使う方法と使わない方法で比べてみた。前者はパーサーという小さな関数に分け、それを組み合わせるようなコーディングをすることになるため、 1つのパーサーあたりの記述量は比較的少ない。そのため、後者に比べ読みやすいコードが書けるのではないかと思う。ただし、デフォルトで用意されているパーサーの性質、パーサーの動作など、いくつか注意しなければならないところはある。