LoginSignup
6
1

More than 3 years have passed since last update.

@mod_poppo

HaskellでWordPress eXtended RSS (WXR)ファイルをパースする

Posted at

この記事は筆者の作業記録です。

前回：HaskellからWordPressのREST APIを叩くメモ

前回に引き続き、WordPressのブログを移行するべく色々試しているmod_poppoです。

前回はJSONでWordPressのAPIを叩いてみましたが、今回はWordPressの「エクスポート」機能で生成されるWXRファイル (WordPress eXtended RSS file) を解釈することを考えてみます。

どのXML処理ライブラリーを使うか

WXRファイルはXMLです。なので、XMLをパースするライブラリーを使うことになります。

HaskellでXMLをパースするライブラリーはいくつかあり、 https://en.wikibooks.org/wiki/Haskell/XML にいくつか挙げられています。

今回はこの中で、 xml (Text.XML.Light) と xml-conduit を試してみました。他の2つはあまりよく見てません。

対象のXMLファイルの構造と、Haskellコードの比較

WXRファイルの構造は大体こういう感じです。WXRファイルのフォーマットはどこでドキュメント化されているのか知りませんが、現物を見ればなんとなくわかります。RSS 2.0ベースのようなのでそっちのドキュメントも読むと良いでしょう。

<rss version="2.0" xmlns:wp="..." xmlns:content="..." ...>
  <channel>
    <title>すごいブログ</title>
    ...
    <item>
      <title>すごい記事</title>
      <pubDate>...</pubDate>
      <content:encoded>
        <![CDATA[すごい本文（HTMLっぽい感じ）]]>
      </content:encoded>
      <wp:post_id>1234</wp:post_id>
      <wp:post_name>sugoi-article</wp:post_name>
      ...
    </item>
    <!-- 以降 <item> がたくさん並ぶ -->
  </channel>
</rss>

このWXRファイルには非表示のコメントも含まれます。筆者のブログにはスパムコメントがたくさんついている（もちろん非表示）のですが、それらもすべてエクスポートされるWXRファイルに含まれるので、ファイルサイズがすごいことになります。具体的には100MB程度となりました。エクスポートの実験目的には、一部の記事だけを含むWXRファイルで試した方が良さそうです。

こういうWXRファイルから、記事タイトル一覧を出力するHaskellコードをText.XML.Lightおよびxml-conduitを使って書くと、次のようになります：

{-# LANGUAGE OverloadedStrings #-}
import qualified Data.Text as T
import qualified Data.Text.IO as T
import qualified Text.XML.Light as XL
import qualified Text.XML as XC
import qualified Text.XML.Cursor as XC
import Control.Monad
import Data.List
import Data.Char (isSpace)
import System.Environment

processFile_xmlconduit :: FilePath -> IO ()
processFile_xmlconduit filename = do
  doc <- XC.readFile XC.def filename
  let doc_cursor = XC.fromDocument doc
  let [channel] = doc_cursor XC.$| XC.child >=> XC.element (XC.Name "channel" Nothing Nothing)
      items = channel XC.$| XC.child >=> XC.element (XC.Name "item" Nothing Nothing)
  forM_ items $ \item -> do
    let title_content = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "title" Nothing Nothing) >=> XC.child >=> XC.content)
    T.putStrLn $ T.dropWhileEnd isSpace $ T.dropWhile isSpace $ title_content

processFile_xmllight :: FilePath -> IO ()
processFile_xmllight filename = do
  contents <- T.readFile filename
  let Just doc = XL.parseXMLDoc contents
      Just channel = XL.findChild (XL.QName "channel" Nothing Nothing) doc
      items = XL.findChildren (XL.QName "item" Nothing Nothing) channel
  forM_ items $ \item -> do
    let Just title = XL.findChild (XL.QName "title" Nothing Nothing) item
    let title_content = concat $ map XL.cdData $ XL.onlyText $ XL.elContent title
    putStrLn $ dropWhileEnd isSpace $ dropWhile isSpace $ title_content

main :: IO ()
main = do
  args <- getArgs
  case args of
    "xml-conduit":filename:_ -> processFile_xmlconduit filename
    "xml-light":filename:_ -> processFile_xmllight filename
    [] -> putStrLn "test-xml-library (xml-conduit|xml-light) <filename.xml>"

xml-conduitやText.XML.LightはCursorと呼ばれるものを使って要素にアクセスします。Cursorはなんかzipperと呼ばれるものに似ていて（？）隣接ノードや子ノードの情報を持っています。

xml-conduitは >=> 演算子を使ってXPathっぽく書けるようになっているようです。Axisとかいう用語が出てくるし。

その他の違いとして、Text.XML.Lightはノードの中身を String で持っているのに対し、xml-conduitは Data.Text を使っています。

実行時間・メモリ使用量の比較

Text.XML.Lightとxml-conduitのそれぞれで同じような処理をするコードが書けたので、どちらが速いのか試してみましょう。

Text.XML.Light:

$ stack exec time test-xml-library xml-light WordPress.2019-10-27.xml +RTS -t -RTS
...
<<ghc: 42874107216 bytes, 41010 GCs, 1002973492/6420948784 avg/max bytes residency (13 samples), 12382M in use, 0.001 INIT (0.003 elapsed), 12.370 MUT (20.441 elapsed), 65.939 GC (74.793 elapsed) :ghc>>
       96.26 real        78.31 user        49.68 sys

xml-conduit:

$ stack exec time test-xml-library xml-conduit WordPress.2019-10-27.xml +RTS -t -RTS
...
<<ghc: 35327154568 bytes, 33460 GCs, 353348819/2413193496 avg/max bytes residency (17 samples), 4812M in use, 0.001 INIT (0.004 elapsed), 9.843 MUT (12.142 elapsed), 28.190 GC (23.637 elapsed) :ghc>>
       36.21 real        38.03 user        16.28 sys

Text.XML.Lightは100秒程度の時間と10GB以上のメモリーを消費したのに対し、xml-conduitは40秒弱、使用メモリーはたったの5GB未満です。というわけでxml-conduitの圧勝です。

何がこんなに差を分けたのかはよくわかりませんが、元のXMLファイルが100MBとかだと文字列に String を使うか、 Data.Text を使うか、という違いは結構バカにならなさそうです。（定量的に調査したわけではないので外しているかも）

ともあれ、使うべきXMLパーサーは決まりました。以後はxml-conduitを使うことにします。

（本当は他のXMLパーサーも試すべきかもしれませんが、使い方を調べるのが面倒＆xml-conduitでそこそこ実用的に実行できるのがわかったので省略します。筆者が調べた限りではHXTもHaXmlもノードの中身を String で持っていたので、ノードの中身の String で持つか Text で持つかが重要という仮説が正しければ、これらはいずれも選択肢から外れます。）

（入力に使った WordPress.2019-10-27.xml はコメントをつけた人（あるいはスパムbot）のメールアドレス等の非公開情報を含むため、公開できません。悪しからず。）

他の情報を取得したり、Pandocに食わせたりする

実際に記事データを書き出すには、記事タイトル以外の情報も必要です。また、記事の本文はHTML風の記法で書かれていますが、手で編集したり静的サイトジェネレーターに食わせたりすることを考えると、Pandocを使ってMarkdown等のフォーマットで書き出したりしたいです。

そんな感じで現在書きかけているコードを晒しておきます。

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE RecordWildCards #-}
import qualified Data.Text as T
import qualified Data.Text.IO as T
import System.Environment
import qualified Text.XML as XC
import qualified Text.XML.Cursor as XC
import Control.Monad
import Data.List
import Data.Char
import Data.Maybe
import Data.Time
import Control.Monad.State.Strict
import Control.Monad.Except
import Text.Pandoc.Class (PandocPure(..))
import Text.Pandoc.Options (ReaderOptions(..), WriterOptions(..), def)
import Text.Pandoc.Readers.HTML (readHtml)
import Text.Pandoc.Writers.Markdown (writeMarkdown)
import Text.Pandoc.Extensions

namespace_dc, namespace_wp, namespace_content :: Maybe T.Text
namespace_dc = Just "http://purl.org/dc/elements/1.1/"
namespace_wp = Just "http://wordpress.org/export/1.2/"
namespace_content = Just "http://purl.org/rss/1.0/modules/content/"

data Post = Post { postTitle :: T.Text
                 , postLink :: T.Text
                 , postPubDate :: Maybe UTCTime
                 , postCreator :: T.Text
                 , postContent :: T.Text
                 , postId :: Maybe Int
                 , postDate :: Maybe LocalTime
                 , postDateGmt :: Maybe LocalTime
                 , postName :: T.Text
                 , postStatus :: T.Text -- publish
                 -- , postType :: T.Text -- post
                 , postCategories :: [T.Text]
                 , postTags :: [T.Text]
                 }
            deriving (Eq, Show)

-- 記事データを output/<slug>.txt および output/<slug>-raw.txt に書き出す。
-- 前者は Markdown に変換したデータ、後者は生データ
renderPostToFile :: Post -> IO ()
renderPostToFile post@Post{..} = do
  let path = "output/" ++ T.unpack postName ++ ".txt"
  let readerOptions :: ReaderOptions
      readerOptions = def { readerExtensions = readerExtensions def <> extensionsFromList [Ext_hard_line_breaks] }
      writerOptions :: WriterOptions
      writerOptions = def { writerExtensions = writerExtensions def <> extensionsFromList [Ext_hard_line_breaks] }
      pandocAction = do doc <- readHtml readerOptions postContent
                        writeMarkdown writerOptions doc
  case flip evalState def $ flip evalStateT def $ runExceptT $ unPandocPure pandocAction of
    Left err -> print err
    Right md -> T.writeFile path $ postTitle <> "\n\n" <> md
  let path_raw = "output/" ++ T.unpack postName ++ "-raw.txt"
  T.writeFile path_raw $ postTitle <> "\n\n" <> postContent

processFile_xmlconduit :: FilePath -> IO ()
processFile_xmlconduit filename = do
  doc <- XC.readFile XC.def filename
  let doc_cursor = XC.fromDocument doc
  let [channel] = doc_cursor XC.$| XC.child >=> XC.element (XC.Name "channel" Nothing Nothing)
      items = channel XC.$| XC.child >=> XC.element (XC.Name "item" Nothing Nothing)
  forM_ items $ \item -> do
    -- element (Name "title" Nothing Nothing) :: Axis
    let title = T.dropWhileEnd isSpace $ T.dropWhile isSpace $ mconcat (item XC.$| XC.child >=> XC.element (XC.Name "title" Nothing Nothing) >=> XC.child >=> XC.content)
    let link_content = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "link" Nothing Nothing) >=> XC.child >=> XC.content)
    let pubDate = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "pubDate" Nothing Nothing) >=> XC.child >=> XC.content) -- rfc822DateFormat %a, %_d %b %Y %H:%M:%S %Z
        pubDate_p = parseTimeM @Maybe @UTCTime True defaultTimeLocale rfc822DateFormat (T.unpack pubDate)
    let creator = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "creator" namespace_dc Nothing) >=> XC.child >=> XC.content)
    let content_encoded = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "encoded" namespace_content Nothing) >=> XC.child >=> XC.content)
    let post_id = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "post_id" namespace_wp Nothing) >=> XC.child >=> XC.content)
    let post_date = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "post_date" namespace_wp Nothing) >=> XC.child >=> XC.content) -- yyyy-mm-dd hh:mm:ss
        post_date_p = parseTimeM @Maybe @LocalTime True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack post_date)
    let post_date_gmt = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "post_date_gmt" namespace_wp Nothing) >=> XC.child >=> XC.content) -- yyyy-mm-dd hh:mm:ss
        post_date_gmt_p = parseTimeM @Maybe @LocalTime True defaultTimeLocale "%Y-%m-%d %H:%M:%S" (T.unpack post_date_gmt)
    let post_name = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "post_name" namespace_wp Nothing) >=> XC.child >=> XC.content)
    let post_status = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "status" namespace_wp Nothing) >=> XC.child >=> XC.content)
    let category = mconcat (item XC.$| XC.child >=> XC.element (XC.Name "category" Nothing Nothing) >=> XC.child >=> XC.content)
    print (title, link_content, pubDate_p, creator, post_name, post_id)
    renderPostToFile Post{ postTitle = title
                         , postLink = link_content
                         , postPubDate = pubDate_p
                         , postCreator = creator
                         , postContent = content_encoded
                         , postId = Nothing
                         , postDate = post_date_p
                         , postDateGmt = post_date_gmt_p
                         , postName = post_name
                         , postStatus = post_status
                         , postCategories = []
                         , postTags = []
                         }

main :: IO ()
main = do
  args <- getArgs
  case args of
    filename:_ -> processFile_xmlconduit filename
    [] -> putStrLn "wxr-parser <filename.xml>"

WordPressの記事本文のデータを処理するには、以下の注意が必要です：

  • 欧文メールやMarkdownやTeXと同じように、空行で暗黙に段落が作られる
  • WordPressの [ ] で囲む記法（タグっぽいやつ、shortcode）を適宜変換する

現状はいずれもあまりうまく処理できていません（前者は最近の記事に関しては掲載したコードでどうにかなっているようですが、古い記事についてはうまくいってません）。

それから、WXRの <item> は記事以外にも、アップロードした画像等のファイルに対しても使われるようです。記事の一覧を得たい場合は、これらを取り除く必要があります。

というわけで、mod_poppo氏のブログ移行プロジェクトはまだ始まったばかりなのです。

その他

今回の処理対象のXMLファイルのように使用されない部分（スパムコメント）が大量にある場合は、文書すべてをデータ構造として保持するDOM型パーサーよりも、必要な部分だけを拾うSAX型パーサーの方が適している気がします。Haskellでそういうことをしたかったらtagsoupとかを使えば良いのでしょうか。

あと、この記事を書いている際にHackageを ググ ハケったら X というパッケージを見つけました。Text.XML.Lightの派生で、文字列型として Text や ShortText を使っているようです。まだリリースされて間もないようですが、これは（性能的に）期待できるのではないでしょうか。余力があったら試したい。

6
1
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
Sign upLogin
6
1