Haskell で XML と JSON をパースする方法

調査がひと段落ついたので冒険の書にセーブ。

XML のパース

Haskell の XML パーサは結構種類が豊富です。

Which Haskell XML library to use? - Stack Overflow によると、

xml: 処理が簡単なら
haxml: 処理が複雑なら
hxt: 矢印が好きなら
hexpat: パフォーマンスを望むなら

ということらしく、僕は xml を選択しました。

インストールは以下の要領で行います。

cabal update
cabal install xml

サンプルのお題は、以下のような XML から、タプルのリストで言語とメッセージを取り出すこと。

<?xml version="1.0" encoding="utf-8"?>
<root>
  <greeting>
    <language>English</language>
    <message>hello</message>
  </greeting>
  <greeting>
    <language>French</language>
    <message>bonjour</message>
  </greeting>
  <greeting>
    <language>Italian</language>
    <message>ciao</message>
  </greeting>
  <greeting>
    <language>Chinese</language>
    <message>nihao</message>
  </greeting>
</root>

コードは以下のようになります。

import Text.XML.Light

getText :: Element -> String -> String
getText parent childName =
  case findChild (unqual childName) parent of
    Nothing -> ""
    Just child ->
      let
        [Text content] = elContent child
      in
        cdData content

parseGreetingTag :: Element -> (String, String)
parseGreetingTag elem = (getText elem "language", getText elem "message")

main :: IO ()
main = do
  xml <- readFile "sample.xml"
  case parseXMLDoc xml of
    Nothing -> error "parse error"
    Just root ->
      print $ map (\a -> parseGreetingTag a) (findChildren (unqual "greeting") root)

出力結果は以下のような感じです。

[("English","hello"),("French","bonjour"),("Italian","ciao"),("Chinese","nihao")]

findChildren で指定した名前の子要素をすべてリストで取り出し、その子要素の languae と message のテキストを補助関数 getText で取り出しています。

XML にアクセスするための関数の名前が直観的で、学習曲線はなだらかだと思います。このライブラリの作者による GitHub 上のサンプルがあったのもとっかかりやすかったです。

XML には DOM 的にアクセスするので、複雑な XML のパースは、コード量がかなり多くなってしまいます。

JSON のパース

JSON のライブラリもいくつか候補があるようなのですが、直観で JSON にしました。

インストールは以下のように行います。

set LANG=C
cabal install json

僕の環境（Windows 7）だと、cabal が：

lexical error (UTF-8 decoding error) cabal: Error: some packages failed to install:

なるエラーを出すので、こちらのブログを参照して set LANG=C することで回避しました。

サンプルのお題は XML と同様、以下の JSON から language と message のタプルリストを取り出すことです。

{
  "greetings": [
    { "language": "English", "message": "hello"   },
    { "language": "French",  "message": "bonjour" },
    { "language": "Italian", "message": "ciao"    },
    { "language": "Chinese", "message": "nihao"   }
  ]
}

コードは以下のようになります。

{-# LANGUAGE DeriveDataTypeable #-}
import Text.JSON
import Text.JSON.Generic

data Greeting = Greeting {
  language :: String,
  message :: String
} deriving (Eq, Show, Data, Typeable)

data GreetingList = GreetingList {
  greetings :: [Greeting]
} deriving (Eq, Show, Data, Typeable)

main :: IO ()
main = do
  json <- readFile "sample.json"
  print $ map (\a -> (language a, message a)) (greetings (decodeJSON json :: GreetingList))

このサンプルは以下のサイトを参考にさせてもらいました。

decodeJSON を使用することで、Haskell のカスタムデータタイプと JSON のデータ構造をマッピングすることができるので、あとはデータを取り出すだけです。XML のパースに比べるとより宣言的にデータにアクセスできるのですが、今回のサンプルの JSON はパースしやすいように配慮してあり、実際のデータは以下のような形式になっていることの方が多いと思います。

[
  { "language": "English", "message": "hello"   },
  { "language": "French",  "message": "bonjour" },
  { "language": "Italian", "message": "ciao"    },
  { "language": "Chinese", "message": "nihao"   }
]

JSON が配列形式だと、今回のような方法が使えず、XML 同様以下のような手続き的なアクセスになります。

import Text.JSON
import Text.JSON.String

val :: String -> JSObject JSValue -> String
val name jsValue = case resultToEither (valFromObj name jsValue) of
  Right a -> fromJSString a
  Left b -> b

createTuple :: JSObject JSValue -> (String, String)
createTuple jsValue = (val "language" jsValue, val "message" jsValue)

main :: IO ()
main = do
  json <- readFile "sample2.json"
  case resultToEither (decode json :: Result [JSObject JSValue]) of
    Right array -> print (map createTuple array)

また最初のサンプルコードの 1 行目のコメント（{-# LANGUAGE DeriveDataTypeable #-}）は GHC 用の pragma で、GHC に依存してしまっています（これがないとコンパイルが通りません）。

まとめ

どちらが良いとか悪いとかはなくて、与えられる、または求められるデータ形式に従って使い分ければよいかと思います。

ドキュメントを斜めに見た感じだと、xml は検索に加え、追加・変更・削除が DOM ツリーを使用して可能です。Element を String にする showTopElement という関数が用意されていて、結果に ?xml? ヘッダも付与されるため XML の生成も可能です。

JSON は Data を JSON にマッピングできるという利点を用いて、かなり宣言的に JSON の生成ができるようになると思います。