Hatena::Grouphaskell

eagletmtの日記 このページをアンテナに追加

2010-08-23

FFI を利用する (1)

| 18:14 |  FFI を利用する (1) - eagletmtの日記 を含むブックマーク はてなブックマーク -  FFI を利用する (1) - eagletmtの日記  FFI を利用する (1) - eagletmtの日記 のブックマークコメント

例として libxml を利用して html をパースしたり XPath を使ってみたりするコードを書いてみる.

ちなみに HaskellXML を扱うライブラリとしては HaXmlhxt がある.

主に RWH 17章本物のプログラマはHaskellを使う - 本物のプログラマはHaskellを使う:ITpro の第22-23回を参考にした.


import 文を毎回書くのがだるいので

import Control.Applicative ((<$>))
import Control.Exception (bracket)
import Data.Bits ((.|.))
import System.IO.Unsafe (unsafePerformIO)
import Foreign.Ptr (Ptr, nullPtr)
import Foreign.ForeignPtr (ForeignPtr, withForeignPtr)
import Foreign.Concurrent (newForeignPtr)
import Foreign.C.String (CString, withCString)
import Foreign.C.Types (CInt)
import Foreign.Storable (peekByteOff)
import Foreign.Marshal.Array (peekArray)
import qualified Data.ByteString as B

あたりを補ってください.


メモリ上にある文字列を html としてパースするには htmlReadMemory が使える.

まずはこれを Haskell の関数としてラップする.

htmlDocPtr (xmlDocPtr) という型の値が返されるので,これを Haskell の型に翻訳しなければならない.

これを実現するために,以下のようにデータ構築子の無いデータ型を利用する方法がよく使われる.

data XmlDocTag
newtype XmlDoc = MkXmlDoc (Ptr XmlDocTag)

さらに XmlDoc でラップすることで,この型だけを外に公開することで opaque なデータ型を表現している.

すると,C の htmlReadMemory はこのように型付けできる.

foreign import ccall "htmlReadMemory" c_htmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XmlDocTag)

htmlReadMemory は htmlDocPtr の領域を確保してそれを返すので IO 型とする必要がある.

foreign import された C の関数には プレフィックスとして c_ をつけるのが慣習らしい.


htmlReadMemory をラップした parseHTML の型として最初に

parseHTML :: B.ByteString -> String -> String -> Int -> IO XmlDoc

を考える.

String → CString の変換には withCString,ByteString → (CString,Int) の変換には useAsCStringLen が使える.

本体の定義はこんなかんじ.

parseHTML src url encoding opt = do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  return $ MkXmlDoc ptr

しかしよく考えてみると parseHTML は参照透明だし,Haskell から見て IO 型である必要はない.

そこで unsafePerformIO を使って IO を外してやるとよい.

unsafePerformIO は無闇に使うと危険だが,ここでは安全…なはず.

parseHTML :: B.ByteString -> String -> String -> Int -> XmlDoc
parseHTML src url encoding opt = unsafePerformIO $ do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  return $ MkXmlDoc ptr

次に問題になるのは,ここで確保された Ptr XmlDocTag のメモリ領域はいつどのようにして解放すべきかということだ.

これを解放するのは C の xmlFreeDoc の仕事で,C のコードでは xmlDocPtr が不必要になった時点でプログラマの責任で xmlFreeDoc を呼んで解放する.

Haskell 上でも同様の方法をとってもいいが,自分で解放するのは面倒だしわざわざ IO アクションを必要とするのもアレなので処理系に任せたい.

Haskell の外で確保されたメモリを保持する場合は ForeignPtr 利用する.

ForeignPtr 型を作るには newForeignPtr が使いやすい.

newForeignPtr の2つ目の引数にファイナライズに必要な IO アクションを渡すと,HaskellGC によって破棄されるときにこれが呼ばれるようになる.

data XmlDocTag
newtype XmlDoc = MkXmlDoc (ForeignPtr XmlDocTag)

parseHTML :: B.ByteString -> String -> String -> Int -> XmlDoc
parseHTML src url encoding opt = unsafePerformIO $ do
  ptr <- B.useAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (fromIntegral opt)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr

newForeignPtr ptr $ c_xmlFreeDoc ptr >> putStrLn "free"

などとして,parseHTML を10000回くらい呼んでみると実際にファイナライザが呼ばれていることを確認できると思う.

ForeignPtr を Ptr として使うときには withForeignPtr を使う.

FFI を利用する (2) hsc2hs

| 18:14 |  FFI を利用する (2) hsc2hs - eagletmtの日記 を含むブックマーク はてなブックマーク -  FFI を利用する (2) hsc2hs - eagletmtの日記  FFI を利用する (2) hsc2hs - eagletmtの日記 のブックマークコメント

FFI とは直接関係は無いが,もう少し Haskell から使いやすい関数にしてみる.

定数オプション

まず htmlReadMemory に渡す定数オプションをそのまま数値として渡すのは使いにくい.

そこで hsc2hs を利用してもうちょっとわかりやすい形で指定できるようにする.

#include <libxml/HTMLparser.h>
newtype HtmlParserOption = HtmlParserOption { unHtmlParserOption :: CInt }
#{enum HtmlParserOption, HtmlParserOption
  , recover = HTML_PARSE_RECOVER
  , noError = HTML_PARSE_NOERROR
  , noWarning = HTML_PARSE_NOWARNING
  , pedantic = HTML_PARSE_PEDANTIC
  , noBlanks = HTML_PARSE_NOBLANKS
  , noNet = HTML_PARSE_NONET
  , noImplied = HTML_PARSE_NOIMPLIED
  , compact = HTML_PARSE_COMPACT
  }

foldOpts :: [HtmlParserOption] -> CInt
foldOpts = foldl (\a -> (a .|. ) . unHtmlParserOption) 0

data XmlDocTag
newtype XmlDoc = MkXmlDoc (ForeignPtr XmlDocTag)

parseHTML :: B.ByteString -> String -> String -> [HtmlParserOption] -> XmlDoc
parseHTML src url encoding opts = unsafePerformIO $ do
  ptr <- B.unsafeUseAsCStringLen src $
          \(cstr,len) -> withCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (foldOpts opts)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr
foreign import ccall "htmlReadMemory" c_htmlReadMemory :: CString -> CInt -> CString -> CString -> CInt -> IO (Ptr XmlDocTag)
foreign import ccall "xmlFreeDoc" c_xmlFreeDoc :: Ptr XmlDocTag -> IO ()

こんなかんじに LibXml.hsc に書いて

% hsc2hs `xml2-config --cflags` LibXml.hsc

とすると LibXml.hs が生成されて,recover, noError といった定数が適切に定義されている.

NULL と Maybe

ドキュメントによると htmlReadMemory の encoding は特に指定しないときは NULL を渡すらしい.

C のライブラリではこのような仕様の関数がよくある.

これを Haskell で表現するには Maybe が適当だろう.

ユーティリティとして

withMaybeCString :: Maybe String -> (CString -> IO a) -> IO a
withMaybeCString (Just str) act = withCString str act
withMaybeCString Nothing act = act nullPtr

なんかを定義して

parseHTML :: B.ByteString -> String -> Maybe String -> [HtmlParserOption] -> XmlDoc
parseHTML src url encoding opts = unsafePerformIO $ do
  ptr <- B.unsafeUseAsCStringLen src $
          \(cstr,len) -> withMaybeCString encoding $
            \e -> withCString url $
              \u -> c_htmlReadMemory cstr (fromIntegral len) e u (foldOpts opts)
  fptr <- newForeignPtr ptr $ c_xmlFreeDoc ptr
  return $ MkXmlDoc fptr

とするとよさそう.


さらに XmlDoc から文字列として XPath で指定した要素を返す関数として

xpath :: String -> XmlDoc -> Maybe ([Node],Int)

を定義してみる.

libxml 側の API としては http://www.xmlsoft.org/html/libxml-xpath.html にあるものを使う.

data NodeTag
newtype Node = MkNode (Ptr NodeTag)
data NodeSetTag
data XPathContextTag
data XPathObjectTag

xpath :: String -> XmlDoc -> Maybe ([Node],Int)
xpath s (MkXmlDoc docPtr) = unsafePerformIO $ do
  ctx <- withForeignPtr docPtr c_xmlXPathNewContext
  obj <- withCString s (`c_xmlXPathEvalExpression` ctx)
  if obj == nullPtr
    then return Nothing
    else do
      nodes <- (#peek xmlXPathObject, nodesetval) obj :: IO (Ptr NodeSetTag)
      if nodes == nullPtr
        then c_xmlXPathFreeObject obj >> return Nothing
        else do
          nr <- fromIntegral <$> ((#peek xmlNodeSet, nodeNr) nodes :: IO CInt)
          tab <- (#peek xmlNodeSet, nodeTab) nodes :: IO (Ptr (Ptr NodeTag))
          ns <- map MkNode <$> peekArray nr tab
          c_xmlXPathFreeObject obj
          return $ Just (ns,nr)
foreign import ccall "xmlXPathNewContext" c_xmlXPathNewContext :: Ptr XmlDocTag -> IO (Ptr XPathContextTag)
foreign import ccall "xmlXPathEvalExpression" c_xmlXPathEvalExpression :: CString -> Ptr XPathContextTag -> IO (Ptr XPathObjectTag)
foreign import ccall "xmlXPathFreeObject" c_xmlXPathFreeObject :: Ptr XPathObjectTag -> IO ()

NULL でエラーチェックとか懐しいですね!!

構造体のメンバにアクセスするには hsc2hs の機能を使って (#peek struct_type, member_name) で行える.

C の配列をリストとして Haskell の表現に直すときには peekArray が便利.

FFI を利用する (3) C でラッパを書く

| 18:14 |  FFI を利用する (3) C でラッパを書く - eagletmtの日記 を含むブックマーク はてなブックマーク -  FFI を利用する (3) C でラッパを書く - eagletmtの日記  FFI を利用する (3) C でラッパを書く - eagletmtの日記 のブックマークコメント

Node だけとれてもしょうがないので,例えばそのノードの textContent を得る関数を定義してみる.

libxml の API では xmlNodeGetContent にあたる.

textContent :: Node -> B.ByteString
textContent (MkNode ptr) = unsafePerformIO $
  bracket (c_xmlNodeGetContent ptr) c_xmlFree B.packCString
foreign import ccall "xmlNodeGetContent" c_xmlNodeGetContent :: Ptr NodeTag -> IO CString
foreign import ccall "xmlFree" c_xmlFree :: Ptr a -> IO ()

これでうまくいってくれればよかったのだけど,なぜか c_xmlFree で落ちる.

libxml/globals.h を見るとなんか #define とかされているようだけど,具体的になぜ失敗するのかよくわからない…

しょうがないので xmlFree を呼ぶだけのラッパを C のほうで書いてそれを呼んだらうまくいった.

#include <libxml/globals.h>

void xmlFree_wrap(void *mem)
{
  xmlFree(mem);
}

ビルドするときは

% gcc -c `xml2-config --cflags` wrapper.c

とコンパイルして,最終的に ghc に wrapper.o も一緒に渡してやればよい.

FFI を利用する (4)

| 18:14 |  FFI を利用する (4) - eagletmtの日記 を含むブックマーク はてなブックマーク -  FFI を利用する (4) - eagletmtの日記  FFI を利用する (4) - eagletmtの日記 のブックマークコメント

最終的なコードと利用サンプル,そしてそれらをビルドする cabal ファイルを最後に載せておく.

libxml.cabal

Name: libxml
Version: 0.1
License: BSD3
Category: Text
Build-type: Simple
Cabal-version: >=1.6

Executable sample
  Main-is: Main.hs
  Other-Modules: LibXml
  Build-depends: base == 4.*, bytestring
  Build-tools: hsc2hs
  Hs-source-dirs: src
  Includes: wrapper.h
  Include-dirs: include
  C-sources: cbits/wrapper.c
  Extra-libraries: xml2

src/LibXml.hsc

 nodes == nullPtr
        then c_xmlXPathFreeObject obj >> return Nothing
        else do
          nr <- fromIntegral <$> ((#peek xmlNodeSet, nodeNr) nodes :: IO CInt)
          tab <- (#peek xmlNodeSet, nodeTab) nodes :: IO (Ptr (Ptr NodeTag))
          ns <- map MkNode <$> peekArray nr tab
          c_xmlXPathFreeObject obj
          return $ Just (ns,nr)
foreign import ccall "xmlXPathNewContext" c_xmlXPathNewContext :: Ptr XmlDocTag -> IO (Ptr XPathContextTag)
foreign import ccall "xmlXPathEvalExpression" c_xmlXPathEvalExpression :: CString -> Ptr XPathContextTag -> IO (Ptr XPathObjectTag)
foreign import ccall "xmlXPathFreeObject" c_xmlXPathFreeObject :: Ptr XPathObjectTag -> IO ()

textContent :: Node -> B.ByteString
textContent (MkNode ptr) = unsafePerformIO $
  bracket (c_xmlNodeGetContent ptr) c_xmlFree B.packCString
foreign import ccall "xmlNodeGetContent" c_xmlNodeGetContent :: Ptr NodeTag -> IO CString
foreign import ccall "xmlFree_wrap" c_xmlFree :: Ptr a -> IO ()

include/wrapper.h

#ifndef LIBXML_WRAPPER_H
#define LIBXML_WRAPPER_H
void xmlFree_wrap(void *mem);
#endif

cbits/wrapper.c

#include <libxml/globals.h>
#include "wrapper.h"

void xmlFree_wrap(void *mem)
{
  xmlFree(mem);
}

src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where
import Control.Monad (forM_)
import System.Environment (getArgs)
import qualified Data.ByteString.Char8 as B8
import LibXml

main :: IO ()
main = do
  args <- getArgs
  forM_ args $ \path -> do
    str <- B8.readFile path
    let doc = parseHTML str "" (Just "UTF-8") [recover, noError, noWarning, noNet]
    case xpath "//a[@href]" doc of
      Nothing -> putStrLn $ path ++ ": failed"
      Just (ns,nr) -> putStrLn (path ++ ": " ++ show nr ++ " nodes") >> mapM_ (B8.putStrLn . B8.append "  " . textContent) ns

NourMaNourMa 2013/03/29 15:14 I just hope whoever wtiers these keeps writing more!

hmdicqgpubhmdicqgpub 2013/03/30 14:30 iW5Mb1 <a href="http://ygnnewkfwyhb.com/">ygnnewkfwyhb</a>

xpfxoyufxpfxoyuf 2013/03/31 22:03 Cz3Fh4 , [url=http://flknbtjovirt.com/]flknbtjovirt[/url], [link=http://kdoazlurskqz.com/]kdoazlurskqz[/link], http://fzjqgrfcplbs.com/

qvgopmulirqvgopmulir 2013/04/01 10:49 Ac343G , [url=http://csqammgdnmrq.com/]csqammgdnmrq[/url], [link=http://kbtjeonmbhzm.com/]kbtjeonmbhzm[/link], http://ntgiiffhvwpi.com/

ゲスト



トラックバック - http://haskell.g.hatena.ne.jp/eagletmt/20100823