5
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 = allocaMessage $ \ 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 ?

  • 3
    I can't answer how to fix it, but this looks like a bug. You should probably complain to the maintainer of whatever package provides Graphics.Win32. – Daniel Wagner Sep 05 '11 at 20:19

1 Answers1

4

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
  • Great answer Tinctorius! A follow up questions: – CoR May 14 '12 at 15:29
  • 1. where can I find Graphics.Win32.Misc in Haskell dir? I have only .hi files in lib folder. 2. This is last yers bug. Wondering why hasn't it been fixed in Haskel package? – CoR May 14 '12 at 15:35
  • 1
    1) You can copy the definition from [here](https://github.com/Tinctorius/win32/blob/5fc830d7e956ad890ec12d0ed29bcae6662625bd/Graphics/Win32/Misc.hsc#L127); this version is already corrected. Alternatively, you could say `cabal unpack win32` on a command prompt (which will create a folder called "win32" in your current directory, and download and unpack the win32 library there) and then look for it. 2) The original maintainer never responded to my e-mail. I've submitted [a pull request through Github](https://github.com/haskell/win32/pull/5) now, which should be resolved much faster :) –  May 14 '12 at 18:44
  • Awesome answer! Another q's if I may: I compiled upper code and it worked with your fix :) But it created window + console window. Why? How to create pure/just a window? The code above looks a lot like http://msdn.microsoft.com/en-us/library/bb384843.aspx Is upper code ok for creating window programs or there is something better? – CoR May 16 '12 at 02:43
  • 1
    Never noticed that before. For some reason, GHC tells the linker to create a "Win32 Console" application default, instead of a "Win32 GUI" one. You can change this behaviour by adding the flag `-optl-mwindows`, which tells the linker to do the latter instead. (Found it in the [GHC FAQ](http://www.haskell.org/haskellwiki/GHC:FAQ#A_console_window_opens_when_my_application_is_supposed_to_be_GUI_only).) –  May 16 '12 at 06:31
  • Thank you - English Dankie -Afrikaans Ke a leboga -Sepedi Danke - Dutch ngyabonga -zulu Merci -French Hvala - Serbian Gracias-Spanish Obrigado-Portugese grazi- Italian Spasibo- Russian – CoR May 16 '12 at 12:47
  • 1
    It's "bedankt" in Dutch. "Danke" is German. In any case: どう致しまして。 ;) –  May 16 '12 at 15:27