2013/12/10

XML を変換するなら Haskell(HXT) で

思えば自分にとってプログラミングとは、XML っぽいドキュメントを操作することでした。 XML パーザを書いてみたりSXML でいろいろがんばったり、やる前から XSLT に挫折したり。 とにかく気持ちよく XML を操作する方法をこれまでいろいろ探してきたわけですが、今はこう断言できます。 XML をいじるのに最高な道具は HXT(Haskell XML Toolbox)であると。 そこで自分用のメモを兼ねて、「こんなふうに HXT を使ってます」を紹介しようと思います。 基本的な Haskell 力が高くないので、「理解を間違っている」とか「もっとこう使うべき」というツッコミ歓迎です。

HXT がうれしい理由

XML のような木構造のデータをいじろうと思ったとき、まず思いつくのは、根っこから順番に要素をたどりつつ処理していく方法です。 しかし、この方法は案外と融通が利きません。 常に部分木だけを見ればいい仕事なら気楽なのですが、親の要素に戻ったり、兄弟要素にアクセスしたりする必要があるときは、 「いま木全体のどこを処理してるか」という情報を持ち歩くしかないからです。 そして、「いま木全体のどこを処理してるか」を意識しながらコードを書くには、かなりの精神力が要求されます。

HXT では、これとはちょっと違う方法で XML の木構造をいじれます。 「木のこの部分を何かに変換」とか「木のここを取り出す」とか、そういう個別の処理を組み合わせることで全体の変換処理を書けるのです。 同様のアプローチをとるツールとしては XSLT がよく知られていますが、 HXT では各処理を「ふつうのプログラミング言語」である Haskell のコードとして書けるので、 はるかに柔軟だといえると思っています(なにせ XSLT に挫折しているので断言するほどの自信はない)。

組み合わせたい各処理は、「XML の木」から「XML の木」への関数だと思えます。それらをいろいろ組み合わせたいのだから、これは「XML の木構造、および、XML木→XML木な関数たち」から「XMLの木構造、および、XML木→XML木な関数たち」への対応だと思えます。というわけで、 HXT では変換処理を Haskell における圏の間の関手 >>> を使ってつなげたりできます。

とはいえ、 >>> だけだと条件分岐もできないし、大して面白い組み合わせが書けないので、 HXT ではもうちょっと広い概念である「アロー」を使って XML 木の変換を組み合わせられるようになっています。アローについて詳しくは『関数プログラミングの楽しみ』の第10章を読んでください(言うまでもなくこれは宣伝です)。

変換を組み合わせる前に

まずは変換処理が一つしかない場合から書いてみます。 <div class="chapter">...<div> という要素を <h1>...</h1> に包み直すという、単純な変換がやりたいとしましょう。 構造を変えるのではなく、属性に応じて要素名を書き換えるだけの処理です。

なにはともあれ、最初に HXT まわりのモジュールを読み込みます。

import Text.XML.HXT.Core
import Text.XML.HXT.Arrow.XmlArrow
import Control.Arrow

これから変換処理をアローとして書いていくわけですが、外界とのやり取りにもアローを使います。 ここでは、ファイルなどの URI を受け取って入力を行うアロー readDocument と、同じく出力を行うアロー writeDocument を使います。 それぞれ入出力の書式などを指定することもできて、 DTD の指定やインデントの有無を設定できるのですが、細かいことはドキュメントを参照してください。 さらに、 main の中でアローを実行するために、 runX という関数を使います。

readDocumentwriteDocument、 それにこれから書く予定の「divh1 に変換する」アローである chapterToH1 という三つのアローをすべて >>> でつないで一つのアローを作り、 それを runX で実行するだけの超単純な main は、こんな感じになります。

main :: IO ()
main = do
  runX (readDocument [] "test.html"
        >>>
        chapterToH1
        >>>
        writeDocument [] "result.html"
        )
  return ()

それでは、肝心の変換処理 chapterToH1 を書いてみましょう。やりたいことは、「もし divclass 属性に chapter を持っていたら要素名を h1 にして、 class 属性はいらないので消してしまう」です。これはそのまま、 XmlTree から XmlTree へのアロー ArrowXml として、こんな Haskell の関数で書けます。

chapterToH1 :: (ArrowXml a) => a XmlTree XmlTree
chapterToH1 =
    processBottomUp
    (ifA (hasName "div" >>> hasAttrValue "class" (=="chapter"))
             ((setElemName $ mkName "h1") >>> removeAttr "class")
             (this))

狙いの div がどこに出てくるかわからないので、 processBottomUp を使って木を再帰的に見るようにしています。 ifA は条件分岐のためのアローです。条件にマッチしない要素はそのまま残しておきたいので、 else に相当する部分では this アローを設定しています(もしマッチする要素だけ残したいなら none というアローを使います)。そのほかのアローの役割は関数名でわかりますね。こんな具合にアローをつなげて、目的の処理を表すアローを書くわけです。

Haskellのパワーを活用する

先ほどの例と同じ要領で「div 要素を class 属性に基づいて都合のいい名前の要素に変換する」アローをコピペで量産し、それら全部を >>> でつなげるだけでも、それなりに役に立つXML変換プログラムが書けそうですが、それはつらいので、できればアローを作る関数を一つだけ作って、それを使って作ったアローたちを >>> で fold できないものかなと考えますよねふつう。実際、アロー版のfoldといえる seqA が用意されているので、こんなふうに書けます。

(seqA . map (uncurry divClassToElem)
           $ [("chapter", "h1")
             ,("section", "h2")
             ,("para", "p")
             ])

これを runX の中に書けばいいわけです。 divClassToElem はこんなふうに定義すればいいでしょう。

divClassToElem :: (ArrowXml a) =>
                  String            -- if DIV is this class,
               -> String            -- turn that into this element.
               -> a XmlTree XmlTree
divClassToElem cls elm =
    processTopDown
    (ifA (hasName "div" >>> isClass cls)
             (tameClass elm)
             (this))

tameClass :: (ArrowXml a) => String -> a XmlTree XmlTree
tameClass elm = (setElemName $ mkName elm) >>>
                removeAttr "class"

isClass :: (ArrowXml a) => String -> a XmlTree XmlTree
isClass val = hasAttrValue "class" (==val)

兄弟をまとめる

もうちょっと現実的な例題として、いかにも組版ソフトが吐き出したっぽい HTML を、それなりに整った HTML に変換したいとします。つまり、こんなデータを……

<html>
<head></head>
<body>
<div class="chapter">XSLTを捨ててHXTを使おう</div>
<div class="para">HXTでXSLTの処理系さえ実装できる!</div>
<div class="section">Allowとは</div>
<div class="para">こまけーこたーどーでもいいんだよ。</div>
<div class="section">HXTの使い方</div>
<div class="bulletA"><span class="shell">cabal install hxt</span></div>
<div class="bulletB"><span class="haskell">import Text.XML.HXT.Core</span></div>
<div class="bulletB"><span class="haskell">let doc = readString [] text</span></div>
<div class="bulletC"><span class="haskell">runX doc</span></div>
</body>
</html>

こんなふうに変換したいとします。

<html>
  <head/>
  <body>
  <h1>XSLTを捨ててHXTを使おう</h1>
  <p>HXTでXSLTの処理系さえ実装できる!</p>
  <h2>Allowとは</h2>
  <p>こまけーこたーどーでもいいんだよ。</p>
  <h2>HXTの使い方</h2>
  <ul>
    <li>
      <code>cabal install hxt</code>
    </li>
    <li>
      <code>import Text.XML.HXT.Core</code>
    </li>
    <li>
      <code>let doc = readString [] text</code>
    </li>
    <li>
      <code>runX doc</code>
    </li>
  </ul>
  </body>
</html>

この例で面倒なのは、 class 属性の値だけに基づいて、元の XML で潰れてしまっている構造(この場合は ul 要素)を取り出さなければならないところです。 面倒とはいっても、リストみたいなデータ構造から「bulletA」~「bulletなんとか」までの連続する要素をとってくるような問題そのものは、Haskell であれば Data.ListgroupBy を使って割と単純に解けてしまいます。 特定の属性の値という条件のままで考えるとちょっと込み入ってしまうので、代わりに要素名がそれぞれ「bulletなんとか」になってると単純化して考えてみます。 HXT なら、要素名を属性の値に変換した木を作るアローを作って前段にかませばいいだけなので、こうみなしても後で困ることはありません。

import qualified Text.XML.HXT.DOM.XmlNode as XN
import Data.List

groupBullet :: [XmlTree] -> [XmlTree]
groupBullet ts = map bulletlines $ groupBy isBullet ts
  where bulletlines [x] = x
        bulletlines a@(x:xs) = XN.mkElement (mkName "ul") [] a

isBullet :: XmlTree -> XmlTree -> Bool
isBullet t1 t2 = case (XN.getElemName t1, XN.getElemName t2) of
  (Just x', Just y') -> let x = qualifiedName x'
                            y = qualifiedName y'
                        in    (isPrefixOf "bullet" x)
                           && (isPrefixOf "bullet" y)
                           && (not $ isPrefixOf "bulletA" y)
  (_, _) -> False

この groupBullet はアローではなく、 XML 木から XML 木への単なる関数です。あとでアローに持ち上げます。

その前に、「bulletなんとか」という class 属性を持つ要素の名前を、その属性の値に変換するアローを書いておきましょう。 これがないと、いま定義した groupBullet 関数を使っても意味がありません(だって、元の木では要素名が全部 div ですから)。

classValToName :: (ArrowXml a) => String -> a XmlTree XmlTree
classValToName cls = 
    setElemName $< ((isClassPrefixOf cls 
                     >>> getAttrValue "class" 
                     >>> arr mkName)
                    `orElse`
                    getElemName)

isClassPrefixOf :: (ArrowXml a) => String -> a XmlTree XmlTree
isClassPrefixOf val =     
    (hasAttrValue "class" (isPrefixOf val))

この classValToName というアローを使って、次のようなアローを mainrunX の中に仕込めば、つぶされていた構造を ul 要素として取り出せます。

processTopDown
(((getChildren >>> classValToName "bullet")
  >>. groupBullet)
 `when` (hasName "body"))

ここでポイントになるのが >>. という演算子です。 この >>. 演算子は、前段にあるアローの行先に対して、リストからリストへの関数を適用したアローを返します。 さきほど定義した groupBullet[XmlTree] -> [XmlTree] な関数だったので、 >>. でアローと接続することで、「bulletなんとか」をグループにして ul でくくるというアローになります。 なお、あからさまな条件を when で指定して全体をわざわざ囲っているのは、こうしないと groupBullet したい要素たちを取ってこれないからです。

最後に、 class 属性の値が「bulletなんとか」の div 要素をすべて li に変換しましょう。 基本は最初に書いた chapterToH1 とまったく同じですが、今度は条件分岐に choiceA アロー使い、上で定義した isClassPrefixOf を条件にしてこんなふうに書いてみました。

bulletToLi :: (ArrowXml a) => a XmlTree XmlTree
bulletToLi =
    choiceA [isClassPrefixOf "bullet" :-> (tameClass "li"),
             this :-> this]

この例の全体を gist に張っておきます。

まとめ

ここでは、ほとんど >>> を使うだけで済む例しか出てきませんでしたが、実際にはかなりたくさんのアローの組み合わせ方が HXT で提供されています。基本的な XML の操作に便利なアローも、あらかじめたくさん実装されています。さらに、 >>. のようなリストとの連携機能も豊富です。おかげで、 Haskell の関数としてなら容易に書けるような処理を、 XML 木の変換をするアローとしてそのまま使えるようになります。

今回の記事で最後に書いたような HTML データの簡単な変換処理は、編集の現場ではちょくちょく遭遇します。 実際、 InDesign のような DTP ソフトが吐き出す XML を整形するのに、 HXT を利用して同じようなスクリプトを書いています。 些細な原稿データを一回だけ変換するなら、エディタの正規表現による置換で済ませてしまうほうがお気楽ですが、もっと複雑だったり素性が知れなかったするXMLデータを繰り返しいじるなら、 HXT も選択肢にいれてあげてください。

というわけで、去年に引き続き、今年の Haskell Advent Calendar 2013 も「編集者のための Haskell 入門」をお届けしました。

No comments :