htmlパーサ一応完成 - 趣味に生きたい

なんとかGoogleのトップページぐらいは全部パースできるようになりました。というわけで作った分を公開します。

-- //////////////////////////////////////////
-- 2007/10/28 LIBERTY
-- html parser
-- /////////////////////////////////////////
import System
import Text.Regex
import Text.ParserCombinators.Parsec
import System.IO.UTF8

main = do cs <- System.IO.UTF8.getContents
          printDomNodeList $ run cs

data DomNode = Element String [DomNode]
                 | Attribute String String
                 | DataString String

printDomTree :: DomNode -> IO()

printDomTree (Attribute s1 s2) = do System.IO.UTF8.print s1
                                    System.IO.UTF8.print s2

printDomTree (DataString s1) = System.IO.UTF8.print s1
printDomTree (Element s x) = do System.IO.UTF8.print s
                                printDomNodeList x

printDomNodeList :: [DomNode] -> IO()                               
printDomNodeList (x:xs) = do printDomTree x
                             printDomNodeList xs

printDomNodeList [] = System.IO.UTF8.putStr ""

run :: String -> [DomNode]
run input = case (parse htmlPars "" input) of
		Right html -> html
                Left err -> [DataString ((show err))]          

htmlPars :: Parser [DomNode]
htmlPars =  do c <- many1 ((try elementPars) <|> (try oneElementPars) 
                 <|>  (try commentPars) <|> stringPars)
               return c  
              
           
elementPars :: Parser DomNode
elementPars = do char '<'
                 b <- many1 letter
                 an <- many attributePars
     	         char '>'
	         c<- many ((try elementPars) <|> (try oneElementPars) 
                   <|> (try commentPars)   <|> stringPars)
                 char '<'
                 char '/'
                 string b
                 char '>'
                 return (Element b (an++c))
             

oneElementPars :: Parser DomNode
oneElementPars = do char '<'
                    b <- many1 (letter <|> (char '!'))
                    as <- many attributePars
                    char '>'
                    return (Element b as) 
               

stringPars :: Parser DomNode
stringPars = do s <- many1 (noneOf "<>")
                return (DataString s)
               

attributePars :: Parser DomNode
attributePars = do try (many1 (char ' '))
                   name <- try (many (letter <|> char '-'))
                   do char '='
                      value <- (partValueAttribute 
                        <|> many (noneOf " >")) 
                      return (Attribute name value)
                     <|> return (Attribute name name)         

partValueAttribute :: Parser String
partValueAttribute = do char '"'
                        s <- many (noneOf ['"'])
                        char '"'
                        return s

commentPars :: Parser DomNode
commentPars = do char '<'
                 char '!'
                 char '-'
                 char '-'
                 com <- many (try twoHypenPars <|> try (noneOf "<>"))
                 char '>'
		 return (DataString com)

twoHypenPars :: Parser Char
twoHypenPars = do char '-'
                  char '-'

　コピーや改変については私の許可なしで好きに使ってください。このコードがプログラムに組み込まれていたとしてもコード全体を公開する必要はありません。まあそのまま使えるようなものでもないのでもし使うとすればコードをいじることになると思います。

　動作についてですが、標準入力からhtmlファイルを読み込んで要素、属性、文字列を分割して表示するようにしています。分割方法に関してはDomTreeが一番わかりやすく良さそうなので採用させてもらいました。DomTreeを作るのにHaskellで使える再帰的な代数型で表現できたことはすごいと思いました。

　さてこのコードについてですが、Googleのページ以外ではどのページをパースできるかよくわかりません。調べてないので。適当ですいません。

　またxhtmlの終了タグがない要素に対する"/>"は受け付けないようになってます。mixiのトップページで試してみて気づきました、が直しませんでした。実用というっよりは習作なんでそこは妥協点としておきました。

　しかしhtmlパーサというものは本当にめんどうでした。変な書き方が許容されすぎです。要素名だけで=と要素値がない場合、例えば ""というものがあったとき""というように解釈されるとか、要素値を""でくくることは特定の文字が含まれていなければ省略できるとか、面倒でした。あと以外にめんどくさかったのがコメント部分の最後の--が2回続いたらコメント終わりという部分でした。区切りが一文字ならtryを使えば簡単に済むのですが、文字列ではうまくできません。結局コメントの最後に余計な-が入るようになってしまってます。

　心残りなのが、utf8-stringパッケージを使ってみたのに日本語をうまく表示できなかったところです。googleのソースコードはUTF-8だったはずなんですが。結局良くわからないです。utf8-stringに関してですが、printなどは一般的に使われているものと衝突してしまうので、完全修飾名で書く必要があります。これはふつうのHaskellプログラミングにのってました。完全修飾名でしかアクセスできないようにすることも可能なようです。

　このコードに関してはこれぐらいにしてまた別のなにかを作ろうと思います。