如何通过Haskell FFI实现EnumSystemLocalesEx绑定？

问题描述

我正在尝试实现对Win32 API的EnumSystemLocalesEx function的Haskell绑定，但仅取得部分成功。我想知道为什么以及如何解决问题。

我的绑定看起来像这样（从Win32包的模块中进行了必要的导入）：

type LOCALE_ENUMPROCEX = LPWSTR -> DWORD -> LPARAM -> IO BOOL
foreign import WINDOWS_CCONV "wrapper"
  mkLOCALE_ENUMPROCEX :: LOCALE_ENUMPROCEX -> IO (FunPtr LOCALE_ENUMPROCEX)

enumSystemLocalesEx :: LOCALE_ENUMPROCEX -> DWORD -> LPARAM -> IO ()
enumSystemLocalesEx callback dwFlags lParam = do
  c_callback <- mkLOCALE_ENUMPROCEX callback
  failIfFalse_ "EnumSystemLocalesEx" $
    c_EnumSystemLocalesEx c_callback dwFlags lParam nullPtr
  freeHaskellFunPtr c_callback
foreign import WINDOWS_CCONV unsafe "windows.h EnumSystemLocalesEx"
  c_EnumSystemLocalesEx :: (FunPtr LOCALE_ENUMPROCEX)
                        -> DWORD
                        -> LPARAM
                        -> LPVOID
                        -> IO Bool

我对此的简单测试如下：

main :: IO ()
main = do
  enumSystemLocalesEx callback 1 0

callback :: LOCALE_ENUMPROCEX
callback c_locale _ _ = do
  locale <- peekTString c_locale
  putStrLn $ "locale is: " <> show locale
  pure True

部分成功如下。编译并运行该测试可执行文件，按字母顺序生成约120余行输出，然后该可执行文件“挂起”，不再产生任何输出，并且不返回-提取如下（en-ER为输出的最后一行；显然有更多的系统区域设置）：

locale is: ""
locale is: "aa"
locale is: "aa-DJ"
locale is: "aa-ER"
locale is: "aa-ET"
...
locale is: "en-CY"
locale is: "en-DE"
locale is: "en-DK"
locale is: "en-DM"
locale is: "en-ER"

好像某处的“容量”已用完。

编辑：如果我将输出更改为putStrLn $ "The locale to be displayed is: " <> show locale（更多字符），它会较早“挂起”（在"ebu"处）。如果我将其更改为print locale（较少的字符），则会稍后“挂起”（在"en-MH"）。如果我将其更改为无输出（callback _ _ _ = pure True），它仍然“挂起”，因此，输出本身不是问题。另外，命令提示符中的行为与Windows终端中的行为相同。我正在使用Windows 10版本2004，并使用stack，解析器lts-16.12（GHC 8.8.4）构建。

解决方法

我已经在与您相同的环境中测试了样本，但出现错误“计划：不安全地重新输入。”：

如果我删除关键字unsafe，则该示例对我有用：

这是我正在使用的示例：

import System.Win32.Types
import Foreign.Ptr
import Foreign.C
type LOCALE_ENUMPROCEX = LPWSTR -> DWORD -> LPARAM -> IO BOOL
foreign import ccall "wrapper"
  mkLOCALE_ENUMPROCEX :: LOCALE_ENUMPROCEX -> IO (FunPtr LOCALE_ENUMPROCEX)

enumSystemLocalesEx :: LOCALE_ENUMPROCEX -> DWORD -> LPARAM -> IO ()
enumSystemLocalesEx callback dwFlags lParam = do
  c_callback <- mkLOCALE_ENUMPROCEX callback
  failIfFalse_ "EnumSystemLocalesEx" $
    c_EnumSystemLocalesEx c_callback dwFlags lParam nullPtr
  freeHaskellFunPtr c_callback
foreign import ccall "windows.h EnumSystemLocalesEx"
  c_EnumSystemLocalesEx :: (FunPtr LOCALE_ENUMPROCEX)
                        -> DWORD
                        -> LPARAM
                        -> LPVOID
                        -> IO Bool


main :: IO ()
main = do
  enumSystemLocalesEx callback 1 0
  putStrLn "Succeed"

callback :: LOCALE_ENUMPROCEX
callback c_locale _ _ = do
  locale <- peekTString c_locale
  putStrLn $ "locale is: " <> show locale
  pure True

似乎如果使用unsafe关键字注释外部导入声明，则向编译器指示该调用不会直接或间接调用另一个Haskell函数。检查{{ 3}}。