wxHaskell での「応答なし」を回避する。

重い処理をしながら textCtrl に記入しようとすると、Windows のイベントループが回らなくなって（応答なし）になってしまい、処理が終了すると一括して表示されてしまうという不具合が起きました。
重い処理をしながら結果をtextCtrl に記入したいのですが、うまく行かないのです。

「.NET TIPS/時間がかかる処理での「応答なし」を回避するには？」を参考にWindowsメッセージを処理する関数をC で書き、textCtrl に書き込むたびに呼ぶようにし、解決しました。

-- ghc --make Main.hs message.c -o msg.exe
 {-# LANGUAGE ForeignFunctionInterface #-}
module Main where

import System.Win32.Process (sleep)
import Graphics.UI.WX   
import Graphics.UI.WXCore.Frame (frameCenter)
import Graphics.UI.WXCore.WxcClassesMZ
import System.Time
import Data.DateTime

main :: IO ()
main = start gui

gui :: IO ()
gui = do 
    form    <- frame [text := "Message test" ]
    p       <- panel form []
    textlog <- textCtrl p [enabled := True, wrap := WrapNone,
                          font := fontFixed{ _fontSize=11,_fontFace = "Monospace"} ] 
    ok   <- button p [text := "実行",   on command := doCommand textlog]
    clr  <- button p [text := "クリア", on command := textCtrlClear textlog, clientSize := sz 50 24]
    quit <- button p [text := "終了" , on command := close form,clientSize := sz 50 24]
    set ok   [clientSize := sz 50 24 ]
    set form [layout :=
                container p $
                  column 0
                    [floatRight 
                       (margin 10 $ row 5 [widget ok, widget clr, widget quit])
                 , hfill $ minsize (sz 350 250) $ widget textlog ]
             , clientSize := sz 350 300]
    frameCenter form
    return ()


doCommand :: (Textual w) => w -> IO ()
doCommand log = do 
    writeDate log 10
    writeText log "done.\n"

writeDate :: (Num t,Textual w) => w -> t -> IO ()
writeDate log 0 = return ()
writeDate log n = do
    sleep 3000       -- 重い処理
    ctime <- getClockTime
    writeText log $ show (fromClockTime ctime) ++ "\n"
    writeDate log (n-1)

writeText :: (Textual w) => w -> String -> IO ()
writeText log str = do
    appendText log str
    c_ProcessMessage  -- これをコメントにすると（応答なし）になる


foreign import ccall   "ProcessMessage"         c_ProcessMessage    :: IO ()

#include <windows.h>

void ProcessMessage (viod){
  /********************************
    if (PeekMessage (&msg,NULL, WM_PAINT, WM_PAINT,PM_NOREMOVE)) {
          TranslateMessage(&msg);
          DispatchMessage(&msg);
    }
  ********************************/
  /** 時間のかかる処理で「処理中」を表現する（前編） **/
  /** http://codezine.jp/article/detail/5332?p=2 **/
  MSG msg;
  while( PeekMessage( &msg, NULL, 0, 0, PM_REMOVE ) ){
    TranslateMessage( &msg );
    DispatchMessage( &msg );
  }
}

Graphics.Win32.Window
peekMessage、translateMessage、dispatchMessage があるけれど使い方が分からない･･･Orz