Hatena::Grouphaskell

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

 | 

2010-08-23

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 が便利.

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

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

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

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

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