🏹

XMLファイルからコンテンツを集めて1つのXMLにする(HXTで)

2024/06/01に公開

いつも忘れる&ハマるのでメモ。

たとえば、複数のHTMLファイルの「body要素の中身だけ」を連接して1つのHTMLファイルにしたいとする。つまり、以下のような2つのHTMLファイルから…、

<html>
<head>...</head>
<body>
  <h1>Title 1</h1>
  <p>foo &amp; baz</p>
</body>
</html>
<html>
<head>...</head>
<body>
  <h1>Title 2</h1>
  <p>hoge &amp; fuga</p>
</body>
</html>

次のようなHTMLファイルを作りたいとする。

<html>
<head>...</head>
<body>
  <h1>Title 1</h1>
  <p>foo &amp; baz</p>

  <h1>Title 2</h1>
  <p>hoge &amp; fuga</p>
</body>
</html>

body 要素の中身」を取り出すのはHXTなら簡単で、hasName "body" >>> getChildren とすればいいんだけど、readDocument では1つのファイルしか開けないから、IOモナドの中でmapM(もしくは forM)して「body 要素の中身」の XTree を取り出し、それらを xshow した String を連接すればいい。

module Main where

import Text.XML.HXT.Core hiding (xshow)
import Text.XML.HXT.DOM.ShowXml (xshow)
import System.Environment
import Control.Monad

main = do
  files <- getArgs
  contents <- forM files $ \s -> do 
    body <- runX $ 
      readDocument [] s
      >>>
      (multi $ hasName "body" >>> getChildren)
    return $ body
  putStrLn $ "<body>" <> concatMap xshow contents <> "</body>"

しかし、実は xshow には罠があって、文字参照を勝手に解釈済みの文字に変換してしまう。つまり上記の例だと &amp; がすべて & になってしまう。まじかよ。

$ runghc concat.hs temp1.html temp2.html
<body>
  <h1>Title 1</h1>
  <p>foo & baz</p>

  <h1>Title 2</h1>
  <p>hoge & fuga</p>
</body>

回避策としては xshowEscapeXml という関数を使う。ところが、これはArrow用なので、runX の中でしか使えない。

module Main where

import System.Environment
import Text.XML.HXT.Core
import Control.Monad

main = do
  files <- getArgs
  contents <- forM files $ \s -> do 
    body <- runX $ 
      xshowEscapeXml $ 
      readDocument [] s
      >>>
      (multi $ hasName "body" >>> getChildren)
    return $ body
  putStrLn $ "<body>" <> (concat . concat) contents <> "</body>"

これで目的の挙動が得られる(<html>タグとか<head>の中身とかはなんとでもなるものとする)。

$ runghc concat.hs temp1.html temp2.html
<body>
  <h1>Title 1</h1>
  <p>foo &amp; baz</p>

  <h1>Title 2</h1>
  <p>hoge &amp; fuga</p>
</body>

Discussion