如何使用 Haskell FFI 实现 EnumSystemLocalesEx 绑定？

Question

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

我的绑定看起来像这样（从 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) 构建。

Answer 1

我已经在与您相同的环境中测试了示例，我收到了错误“schedule: re-entered unsafely.”：

如果我删除关键字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 函数。检查@987654323 中的答案@了解详情。