如何在haskell中封装对象构造函数和析构函数

Question

我有Haskell代码需要与C库接口,有点像这样:

// MyObject.h
typedef struct MyObject *MyObject;
MyObject newMyObject(void);
void myObjectDoStuff(MyObject myObject);
//...
void freeMyObject(MyObject myObject);

原始的FFI代码将所有这些函数包装为纯函数unsafePerformIO.这导致了错误和不一致,因为操作的顺序是不确定的.

我正在寻找的是一种处理Haskell中的对象而不诉诸于所有内容的一般方法IO.什么是好的是我可以做的事情,如:

myPureFunction :: String -> Int
-- create object, call methods, call destructor, return results

有没有一个很好的方法来实现这一目标？

Answer 1

我们的想法是不断传递每个组件的接力棒,以强制按顺序评估每个组件.这基本上就是状态monad(IO实际上是一个奇怪的状态monad.有点).

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
import Control.Monad.State

data Baton = Baton -- Hide the constructor!

newtype CLib a = CLib {runCLib :: State Baton a} deriving Monad

然后你就把操作串起来了.将它们注入CLibmonad将意味着它们被排序.从本质上讲,你可以IO以一种更加不安全的方式伪装自己,因为你可以逃脱.

然后,你必须确保你添加construct和destruct全部结束CLib链.这可以通过导出类似的函数轻松完成

clib :: CLib a -> a
clib m = runCLib $ construct >> m >> destruct

跳过的最后一个大箍是确保当你unsafePerformIO进入时construct,它实际上得到了评估.

坦率地说,这一切都是毫无意义的,因为它已经存在,战斗证明了IO.而不是整个精心制作的过程,只是如何

construct :: IO Object
destruct  :: IO ()
runClib :: (Object -> IO a) -> a
runClib = unsafePerformIO $ construct >>= m >> destruct

如果您不想使用该名称IO:

newtype CLib a = {runCLib :: IO a} deriving (Functor, Applicative, Monad)

Answer 2

我的最终解决方案。它可能有一些我没有考虑到的微妙错误，但它是迄今为止唯一满足所有原始标准的解决方案：

• 严格 - 所有操作均按正确顺序排列
• 摘要 - 该库被导出为一个有状态的 monad，而不是一组泄漏的 IO 操作
• 安全 - 用户可以在不使用 unsafePerformIO 的情况下将此代码嵌入到纯代码中，并且他们可以期望结果是纯的

不幸的是，实现有点复杂。

例如

// Stack.h
typedef struct Stack *Stack;
Stack newStack(void);
void pushStack(Stack, int);
int popStack(Stack);
void freeStack(Stack);

c2hs 文件：

// Stack.h
typedef struct Stack *Stack;
Stack newStack(void);
void pushStack(Stack, int);
int popStack(Stack);
void freeStack(Stack);

测试程序：

{-# LANGUAGE ForeignFunctionInterface, GeneralizedNewtypeDeriving #-}
module CStack(StackEnv(), runStack, pushStack, popStack) where
import Foreign.C.Types
import Foreign.Ptr
import Foreign.ForeignPtr
import qualified Foreign.Marshal.Unsafe
import qualified Control.Monad.Reader
#include "Stack.h"
{#pointer Stack foreign newtype#}

newtype StackEnv a = StackEnv
 (Control.Monad.Reader.ReaderT (Ptr Stack) IO a)
 deriving (Functor, Monad)

runStack :: StackEnv a -> a
runStack (StackEnv (Control.Monad.Reader.ReaderT m))
 = Foreign.Marshal.Unsafe.unsafeLocalState $ do
  s <- {#call unsafe newStack#}
  result <- m s
  {#call unsafe freeStack#} s
  return result

pushStack :: Int -> StackEnv ()
pushStack x = StackEnv . Control.Monad.Reader.ReaderT $
 flip {#call unsafe pushStack as _pushStack#} (fromIntegral x)

popStack :: StackEnv Int
popStack = StackEnv . Control.Monad.Reader.ReaderT $
 fmap fromIntegral . {#call unsafe popStack as _popStack#}

建造：

-- Main.hs
module Main where
import qualified CStack
main :: IO ()
main = print $ CStack.runStack x where
 x :: CStack.StackEnv Int
 x = pushStack 42 >> popStack