Message Box Error : foreign import unsafe

import Graphics.Win32
import System.Win32.DLL
import Control.Exception (bracket)
import Foreign
import System.Exit
main :: IO ()
main = do
    mainInstance <- getModuleHandle Nothing
    hwnd <- createWindow_ 200 200 wndProc mainInstance
    createButton_ hwnd mainInstance
    messagePump hwnd
wndProc :: HWND -> WindowMessage -> WPARAM -> LPARAM -> IO LRESULT
wndProc hwnd wmsg wParam lParam
    | wmsg == wM_DESTROY = do
        sendMessage hwnd wM_QUIT 1 0
        return 0
    | wmsg == wM_COMMAND && wParam == 1 = do
        messageBox nullPtr "Yahoo!!" "Message box" 0 -- Error! Why? :(
        return 0
    | otherwise = defWindowProc (Just hwnd) wmsg wParam lParam
createWindow_ :: Int -> Int -> WindowClosure -> HINSTANCE -> IO HWND
createWindow_ width height wndProc mainInstance = do
    let winClass = mkClassName "ButtonExampleWindow"
    icon <- loadIcon Nothing iDI_APPLICATION
    cursor <- loadCursor Nothing iDC_ARROW
    bgBrush <- createSolidBrush (rgb 240 240 240)
    registerClass (cS_VREDRAW + cS_HREDRAW, mainInstance, Just icon, Just cursor, Just bgBrush, Nothing, winClass)
    w <- createWindow winClass "Button example" wS_OVERLAPPEDWINDOW Nothing Nothing (Just width) (Just height) Nothing Nothing mainInstance wndProc
    showWindow w sW_SHOWNORMAL
    updateWindow w
    return w
createButton_ :: HWND -> HINSTANCE -> IO ()
createButton_ hwnd mainInstance = do
    hBtn <- createButton "Press me" wS_EX_CLIENTEDGE (bS_PUSHBUTTON + wS_VISIBLE + wS_CHILD) (Just 50) (Just 80) (Just 80) (Just 20) (Just hwnd) (Just (castUINTToPtr 1)) mainInstance
    return ()
messagePump :: HWND -> IO ()
messagePump hwnd = allocaMess开发者_如何学运维age $ \ msg ->
    let pump = do
        getMessage msg (Just hwnd) `catch` \ _ -> exitWith ExitSuccess
        translateMessage msg
        dispatchMessage msg
        pump
    in pump

Here is simple win32 gui application with a button but when I click the button there must be a message box (22 line) but there is error :

buttons.exe: schedule: re-entered unsafely. Perhaps a 'foreign import unsafe' should be 'safe'?

How can I fix it ?

Like Daniel Wagner commented, this is a bug in the Win32 package. MessageBoxW must be imported safely, because of the many side-effects it has.

The messageBox function is a wrapper for the 'unsafely' imported MessageBoxW function. When an unsafely imported function function is unsafely imported, Haskell assumes that the thread will not call any Haskell code until it returns. However, if you call MessageBoxW, Windows will throw quite a few window messages to the window you created in line 30, so Haskell code will be ran while you're in an unsafe foreign function. This is also the reason why calls to messageBox will work until that window has been created.

A possible workaround is to simply correct the function yourself. First, change

import Graphics.Win32

to

import Graphics.Win32 hiding (messageBox, c_MessageBox)

Then, copy the definitions of messageBox and c_MessageBox from the module Graphics.Win32.Misc, with unsafe removed and/or safe added:

messageBox :: HWND -> String -> String -> MBStyle -> IO MBStatus
messageBox wnd text caption style =
  withTString text $ \ c_text ->
  withTString caption $ \ c_caption ->
  failIfZero "MessageBox" $ c_MessageBox wnd c_text c_caption style
foreign import stdcall safe "windows.h MessageBoxW"
  c_MessageBox :: HWND -> LPCTSTR -> LPCTSTR -> MBStyle -> IO MBStatus