Haskell から wxWidgets(C++) を呼ぶ

wxWidgetsには wxHaskell に使用されているGUI以外にも wxStringwxVariant など有用なライブラリがあります。
Haskell から wxWidgetswxAutomationObject で COM を操作してみます。
(以下は wxWidgets がインストールされた環境を前提としています。wxWidgets のインストールについては「wxHaskell をインストールする」)

#include <iostream>
#include <wx/msw/ole/automtn.h>
#include <wx/wx.h>
#include <wx/string.h>

extern "C" {

typedef wxAutomationObject WxAutomation;
typedef wxVariant          WxVariant;
typedef wxString           WxString;

inline wxString _U(const char String[] = ""){
    return wxString(String, wxConvUTF8);
}

WxAutomation* wxCreateInstance( char* instanceName ){
    wxAutomationObject *p = new wxAutomationObject();
    p->CreateInstance(_U(instanceName));
    return p;
}

void destroyWxAutomation(WxAutomation* p){ delete p;}

void destroyWxVariant(WxVariant* var){ delete var;}

void destroyWxString(WxString* str){ delete str;}

WxVariant* wxCallMethod(WxAutomation* p, char* methodName,  char* arg){
    WxVariant *ret = new WxVariant();
    *ret = p->CallMethod(_U(methodName), _U(arg));
    return ret;
}

WxString* variantGetString(WxVariant* var){
    WxString *ret = new WxString();
    *ret = var->GetString();
    return ret;
}

char* WxStringToCString(WxString* str){
    int len = strlen((const char*)str->mb_str(wxConvUTF8));
    char *cstring  = (char*)malloc((len +1) * sizeof(char));
    strcpy( cstring, (const char*)str->mb_str(wxConvUTF8) ); 
    return cstring;
}

}

Scripting.FileSystemObject を作って GetAbsolutePathName メソッドにより fname.cpp のパスを含めたファイル名を取得します。

{-# LANGUAGE ForeignFunctionInterface #-}

module Main where

import Foreign.Ptr
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Cinnamon.Ucs          (ucs4ToUtf8,utf8ToUcs4)

data WxAutomation = WxAutomation
data WxVariant    = WxVariant
data WxString     = WxString

main :: IO ()
main = do
    c_OleInitialize 0
    obj     <- createInstance   "Scripting.FileSystemObject"
    variant <- wxCallMethod obj "GetAbsolutePathName" $ ucs4ToUtf8 "日本語.xls"
    putStrLn =<< variantToString variant
    c_destroyWxAutomation obj
    c_destroyWxVariant variant
    c_OleUninitialize

createInstance :: String ->IO (Ptr WxAutomation)
createInstance objName = do
    cObjName <- newCString  objName
    fileObj  <- c_wxCreateInstance cObjName
    free cObjName
    return fileObj

wxCallMethod :: (Ptr WxAutomation) -> String -> String -> IO (Ptr WxVariant)
wxCallMethod auto methodName arg = do
    cMethodName <- newCString methodName
    cArg        <- newCString arg
    variant     <- c_wxCallMethod  auto cMethodName cArg
    mapM_ free [cMethodName, cArg]
    return variant

variantToString :: (Ptr WxVariant)->IO String
variantToString variant = do
    wxStr   <- c_variantGetString variant
    string  <- peekCString =<< c_WxStringToCString wxStr
    c_destroyWxString wxStr
    return $ utf8ToUcs4 string

foreign import ccall "wxCreateInstance"    c_wxCreateInstance    :: CString -> IO(Ptr WxAutomation)
foreign import ccall "destroyWxAutomation" c_destroyWxAutomation :: (Ptr WxAutomation)->IO()
foreign import ccall "destroyWxVariant"    c_destroyWxVariant    :: (Ptr WxVariant)->IO()
foreign import ccall "destroyWxString"     c_destroyWxString     :: (Ptr WxString)->IO()
foreign import ccall "wxCallMethod"        c_wxCallMethod    :: (Ptr WxAutomation)->CString->CString->IO(Ptr WxVariant)
foreign import ccall "variantGetString"    c_variantGetString    :: (Ptr WxVariant)->IO(Ptr WxString)
foreign import ccall "WxStringToCString"   c_WxStringToCString   :: (Ptr WxString)->IO CString
foreign import ccall   "stdio.h  printf"        c_printf            :: CString -> IO ()
foreign import ccall   "string.h strcat"        c_Strcat            :: CString -> CString -> IO (CString)
foreign import stdcall "ole2.h OleInitialize"   c_OleInitialize     :: CInt -> IO ()
foreign import stdcall "ole2.h OleUninitialize" c_OleUninitialize   :: IO ()

別にコンパイルしないで ghc --make Main.hs fname.cpp ・・・とするとリンクエラーになる。<- ここで挫折していました
FFI使ってC++バインディングに入門を参考に分けるとOKでした。
fname.cpp のコンパイル

g++ fname.cpp -c `wx-config --cxxflags` -o fname.o

wx-configは開発環境からコンパイルのパラメータを出力するためのコマンドです。
README.txtWindows 版の開発者は日本人のようです。
HaskellコンパイルC++ オブジェクト・ファイルとのリンク。パラメータは wx-config --libs と wx-config --cxxflags の出力からエラーになるものを除去したものです。
-I パラメータは インクルードファイルのあるディレクトリをコンパイラに教え、-L パラメータはライブラリのあるディレクトリをリンカに教えているようです。

# http://www.hakodate-ct.ac.jp/~tokai/tokai/gtkmm/etc/p1.htm
ghc --make Main.hs fname.o \
-DHAVE_W32API_H -D__WXMSW__ -D_UNICODE \
-I/c/msys/1.0/home/userName/wxMSW-2.8.11/lib/gcc_dll/mswu \
-I/c/msys/1.0/home/userName/wxMSW-2.8.11/include \
-DWXUSINGDLL \
-L/c/msys/1.0/home/userName/wxMSW-2.8.11/lib/gcc_dll \
-L/c/MinGW/lib \
-lstdc++  \
-lwxtiff -lwxjpeg -lwxpng -lwxzlib -lwxregexu \
-lwxexpat -lkernel32 -luser32 -lgdi32 -lcomdlg32 -lwxregexu \
-lwinspool -lwinmm -lshell32 -lcomctl32 -lole32 -loleaut32 \
-luuid -lodbc32 -lodbccp32 -lrpcrt4 -ladvapi32 -lwsock32 -lwxmsw28u -o fname.exe

使用するターミナル
MSYS の付属のターミナルでは wx-config がエラーになりますので、PowerShell から bash を開いてその中で実行します。

bash.exe"-3.1$ ./cpp.bat
[1 of 1] Compiling Main             ( Main.hs, Main.o )
Linking fname.exe ...
bash.exe"-3.1$ ./fname.exe
C:\C\filename\日本語.xls