パーサー・コンビネーターで Web スクレイピング

パーサー・コンビネーター (parser.ss) を使って、テキスト全体の解析だけでなく、部分を抽出することも可能なんじゃないかと思い付き、実験してみました。

例として、はてなダイアリーに貼り付けられているコードを抽出するパーサーを作ります。

このページのソースを見ていただくと良く分かると思いますが、Scheme のコード部分は PRE タグに囲まれています。

構文ハイライト無しの場合はシンプルにタグの間の文字列を読み取れば良いんですが、有りの場合、構文要素ごとに細かく SPAN タグが埋め込まれています。

そのまま抽出しても読みにくいので何とかしたいんですが、とりあえず、タグ無しの文字列を読み取るパーサーを作ることにしましょう。

基本的には "<" 以外の文字を読み取るだけで良いと思うんですが、文字実体参照が有った場合には特別な処理が必要となります。

(define entities
  '((amp . #\&) (lt . #\<) (gt . #\>) (apos . #\') (quot . #\")))

(define entity-ref
  ((between (char #\&) (char #\;))
   (doP (l <- (many letter))
        (return
         (cond ((assq (list->symbol l) entities) => cdr)
               (else #\?))))))

(define list->symbol
  (compose string->symbol list->string))

このように、(若干手抜きですが) 文字実体参照を実際の文字に変換するパーサーを作り、

(define text
  (fmap list->string
        (many1 (</> (none-of '(#\< #\&))
                    entity-ref))))

とします。none-of の引数でない文字、または実体参照を、1個以上読み取って、それを文字列に変換する、というパーサーです。

次に、タグを無視するパーサーを作りましょう。Perl の正規表現風に:

(define /.*?>/
  (skip-till any-char (char #\>)))

(define /<.*?>/
  (doP (char #\<) /.*?>/))

下の方がタグを完全に無視するパーサーです。skip-till は最短マッチを行うパーサーですので複数のタグを無視してしまう心配はありません。

すると、タグを読み飛ばしつつテキストのみを読み取るパーサーがこのように書けます:

(define ignore-tag
  (</> text
       (doP /<.*?>/ (return ""))))

(細かい話ですが、上の text の定義で many1 の代わりに many を使ってしまうと、このパーサーは無限ループになります)

これに開始・終了タグを読むパーサーを加えることで、構文ハイライトの有無に関わらず、PRE の中身のテキストだけを抽出できるようになります:

(define (tagname name)
  (doP (chars-ic name)
       (followed-by (</> space (char #\>)))))

(define (start-tag name)
  (doP (char #\<) (tagname name)))

(define (end-tag name)
  ((between (chars "</") /.*?>/)
   (tagname name)))

(define pre
  (doP (start-tag "pre")
       /.*?>/     ; skip attributes, if any
       (t <- (many-till ignore-tag (end-tag "pre")))
       (return (foldr string-append "" t))))

さて、ここまでで目的は殆ど達成できたんですが、ソース・テキストの「一部」を抽出するための仕組みがまだです。

そこで、関係ない部分は読み飛ばして目的の個所を探す、seek というコンビネーターを作ってみました:

(define (seek p)
  (lambda (input)
    (let loop ((input input))
      (receive (err1 x input1) (p input)
        (if err1
            (receive (err2 y input2) (any-char input)
              (if err2
                  (values err2 y input2)
                  (loop input2)))
            (values #f x input1))))))

(Gauche の parser.peg に倣ってパース結果を3値で返すスタイルにしました)

パーサー p が失敗すると1字読み進め、そこからパースを再開する、というものです。

これによって、ページ中の PRE タグの中身を全て抽出するパーサーが実に簡単に定義できることになります:

(define codes (many (seek pre)))

利用例:

(call/input-url (string->url
                 "http://d.hatena.ne.jp/reinyannyan/20080916/p1")
  get-pure-port
  (lambda (in)
    (for-each display
              (parse codes in))))

ここからは余談で、複数のパーサーを seek したい場合の定義法についてです。

テキスト中に、抽出したい対象が2種類あったとします。それぞれについてパーサー p1 と p2 を作ったとき、次のどちらの定義が適切でしょうか？

(</> (seek p1) (seek p2))

(seek (</> p1 p2))

</> は ordered choice (優先度付き選択) コンビネーターと言います。最初の方のパーサーが成功した場合、その結果が返され、それ以降のパーサーは実行されません。

この </> の性質と、seek が無制限に先読みするという性質から、前者の定義では (seek p1) が成功した場合に、それ以前に p2 でパースできる対象があっても読み飛ばしてしまうことになるのです。

ということで、後者が良いということになります。

また、2つの定義で結果が異なることから、代数学的に言うと seek は </> に対して分配法則を満たしていない、と言うことができます。

一方、満たすパーサーも有ります。(lexeme p) という、パーサー p の後の空白を読み飛ばすパーサーがそうです。すなわち、

(</> (lexeme p1) (lexeme p2))

(lexeme (</> p1 p2))

は全く同じ結果になります。