正規表現ちっくなパーサーコンビネーター

たとえば、論文を書いていて、図が本文からちゃんと参照されているかを調べたいとします。LaTeX で書いているなら、\ref{} と \label{} の中の文字列を突き合わす訳です。正規表現を使えば、テキスト全体からこれらの文字列を抽出するのは簡単です。でも、Haskell から正規表現を使うのは、かっこ悪いなぁという気がします。そこで、Parsec を使って、以下のようなパーサーを定義します。

label :: Parser String
label = string "\\label{" *> many1 (noneOf "}") <* char '}'

さて、このパーサーが受理する部分を全部返すというパーサーコンビネーターを書く訳ですが、これが意外と難しい。というか、パーサーのことを深く理解してないと書けない気がします。という訳で、こんなのを書いてみました。

appear :: Parser a -> Parser [a]
appear p = before pOrEof *> many (p <* before pOrEof) <* eof
  where
    pOrEof = (() <$ p) <|> eof

before :: Parser a -> Parser ()
before p = (() <$ try (lookAhead p)) <|> (anyChar >> before p)

appear label で parse すれば、\label{} の中の文字列を抽出しリストにして返してくれます。という訳で、質問なんですが appear はもっと簡単に実現できますか？ あと、もっといい名前も募集したいです。

おまけ：\ref{}と\label{}を付き合わせるプログラム：

module Main where

import Control.Applicative hiding ((<|>), many)
import Data.List
import Text.Parsec hiding (label)
import Text.Parsec.String

label :: Parser String
label = string "\\label{" *> many1 (noneOf "}") <* char '}'

ref :: Parser String
ref = string "\\ref{" *> many1 (noneOf "}") <* char '}'

appear :: Parser a -> Parser [a]
appear p = before pOrEof *> many (p <* before pOrEof) <* eof
  where
    pOrEof = (() <$ p) <|> eof

before :: Parser a -> Parser ()
before p = (() <$ try (lookAhead p)) <|> (anyChar >> before p)

parseIt :: Parser a -> String -> a
parseIt p cs = case parse p "dummy" cs of
    Left  e -> error . show $ e
    Right r -> r
        
main :: IO ()
main = do
    cs <- getContents
    let ls = parseIt (appear label) cs
        rs = parseIt (appear ref) cs
        ls' = nub . sort $ ls
        rs' = nub . sort $ rs
    putStrLn $ "labels - refs: " ++ show (ls' \\ rs')
    putStrLn $ "refs - labels: " ++ show (rs' \\ ls')

追加

Maybe を使って非効率にやるなら、こうかな。

appear :: Parser a -> Parser [a]
appear p = catMaybes <$> many p'
  where
    p' = try (Just <$> p) <|> (anyChar >> return Nothing)

これが一番奇麗かも。

appear :: Parser a -> Parser [a]
appear p = before p *> many (p <* before p)

before :: Parser a -> Parser ()
before p = (() <$ try (lookAhead p)) <|> (anyChar >> before p) <|> eof

t さんから教えてもらったコードをちょっと変更：

appear :: Parser a -> Parser [a]
appear p = (:) <$> try p <*> appear p
       <|> anyChar *> appear p
       <|> [] <$ eof