Finestra di messaggio di errore: estero di importazione non sicuri

Question

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

Ecco un'applicazione GUI semplice win32 con un pulsante, ma quando clicco il tasto ci deve essere una finestra di messaggio (22 linee), ma non v'è errore:

buttons.exe: calendario: re-immesso non sicuro. Forse un 'estero importare non sicuro' dovrebbe essere 'sicuro'?

Come posso risolvere il problema?

Answer 1

Come Daniele Wagner ha commentato, questo è un bug nel pacchetto di Win32. MessageBoxW deve essere importato in modo sicuro, a causa dei numerosi effetti collaterali che ha.

La funzione messageBox è un wrapper per la funzione MessageBoxW 'non sicuro' importato. Quando una funzione funzione non sicuro importato viene importato non sicuro, Haskell presuppone che il filo non chiamare qualsiasi codice Haskell finché non ritorna. Tuttavia, se si chiama MessageBoxW, Windows gettare un bel paio di messaggi di finestra alla finestra si è creato in linea 30, in modo da codice Haskell sarà corse mentre si è in una funzione estera non sicuro. Questo è anche il motivo per cui le chiamate verso messageBox lavoreranno fino a è stato creato quella finestra.

Una possibile soluzione è quella di correggere semplicemente la funzione di se stessi. In primo luogo, il cambiamento

import Graphics.Win32

a

import Graphics.Win32 hiding (messageBox, c_MessageBox)

Quindi, copiare le definizioni di messageBox e c_MessageBox dal Graphics.Win32.Misc del modulo, con unsafe rimossi e / o safe aggiunto:

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