nhắn Box Lỗi: nhập khẩu nước ngoài không an toàn

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 

Đây là đơn giản win32 ứng dụng gui với một nút nhưng khi tôi bấm nút phải có một hộp thông báo (22 dòng) nhưng có lỗi:

nút .exe: schedule: nhập lại không an toàn. Có lẽ một 'ngoại lai nhập không an toàn' phải là 'an toàn'?

Làm cách nào để khắc phục sự cố?

Answer 1

Giống như Daniel Wagner đã nhận xét, đây là lỗi trong gói Win32. MessageBoxW phải được nhập an toàn vì có nhiều tác dụng phụ.

Chức năng messageBox là trình bao bọc cho chức năng MessageBoxW được nhập 'không an toàn'. Khi một hàm chức năng được nhập không đúng cách được nhập không đúng, Haskell giả định rằng luồng sẽ không gọi bất kỳ mã Haskell nào cho đến khi nó trả về. Tuy nhiên, nếu bạn gọi MessageBoxW, Windows sẽ gửi một vài thông báo cửa sổ đến cửa sổ bạn đã tạo trong dòng 30, vì vậy mã Haskell sẽ được chạy trong khi bạn đang ở trong một chức năng nước ngoài không an toàn. Đây cũng là lý do tại sao các cuộc gọi đến messageBox sẽ hoạt động cho đến khi cửa sổ đó đã được tạo.

Cách giải quyết có thể là chỉ cần tự sửa chính chức năng. Trước hết, thay đổi

import Graphics.Win32 

để

import Graphics.Win32 hiding (messageBox, c_MessageBox) 

Sau đó, sao chép các định nghĩa của messageBox và c_MessageBox từ các module Graphics.Win32.Misc, với unsafe loại bỏ và/hoặc safe thêm:

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