带IO的Haskell多元函数

有没有可能让一个函数在外部函数的某些参数为CString的情况下接受外部函数调用，并返回一个接受字符串的函数

以下是我正在寻找的一个例子：

 foreign_func_1 :: (CDouble -> CString -> IO())
 foreign_func_2 :: (CDouble -> CDouble -> CString -> IO ())

 externalFunc1 :: (Double -> String -> IO())
 externalFunc1 = myFunc foreign_func_1

 externalFunc2 :: (Double -> Double -> String -> IO())
 externalFunc2 = myFunc foreign_func_2

我想出了如何使用C数字类型来实现这一点。但是，我想不出一种允许字符串转换的方法

这个问题似乎适用于IO函数，因为所有转换为CString（如newCString或withCString）的东西都是IO

下面是处理双精度转换的代码

class CConvertable interiorArgs exteriorArgs where
   convertArgs :: (Ptr OtherIrrelevantType -> interiorArgs) -> exteriorArgs

instance CConvertable (IO ()) (Ptr OtherIrrelevantType -> IO ()) where
   convertArgs = doSomeOtherThingsThatArentCausingProblems
instance (Real b, Fractional a, CConvertable intArgs extArgs) => CConvertable (a->intArgs) (b->extArgs) where
    convertArgs op x= convertArgs (\ctx -> op ctx (realToFrac x))

---

这绝对有可能。通常的方法是使用cstring创建lambda以传递给

。以您的例子：

myMarshaller :: (CDouble -> CString -> IO ()) -> CDouble -> String -> IO ()
myMarshaller func cdouble string = ...

withCString :: String -> (CString -> IO a) -> IO a

内部函数具有类型
CString->IO a
，这正是将
CDouble
应用于C函数
func
后的类型。您的作用域中也有一个
CDouble
，所以这就是您所需要的一切

myMarshaller func cdouble string =
  withCString string (\cstring -> func cdouble cstring)

这是一个可怕的两类解决方案。第一部分（命名为，毫无帮助，
foo
）将采用类似
Double->Double->CString->IO（）
的类型，并将它们转换为类似
IO（Double->IO（Double->IO（String->IO（）））
。因此，每次转换都被强制到IO中，只是为了保持完全一致

第二部分（命名为“崩溃io”的
cio
）将把这些东西放到最后

class Foo a b | a -> b where
    foo :: a -> b
instance Foo (IO a) (IO a) where
    foo = id
instance Foo a (IO b) => Foo (CString -> a) (IO (String -> IO b)) where
    foo f = return $ \s -> withCString s $ \cs -> foo (f cs)
instance Foo a (IO b) => Foo (Double -> a) (IO (Double -> IO b)) where
    foo f = return $ \s -> foo (f s)

class CIO a b | a -> b where
    cio :: a -> b
instance CIO (IO ()) (IO ()) where
    cio = id
instance CIO (IO b) c => CIO (IO (a -> IO b)) (a -> c) where
    cio f = \a -> cio $ f >>= ($ a)

{-
*Main> let x = foo (undefined :: Double -> Double -> CString -> IO ())
*Main> :t x
x :: IO (Double -> IO (Double -> IO (String -> IO ())))
*Main> :t cio x
cio x :: Double -> Double -> String -> IO ()
-}

除了通常很糟糕之外，还有两个特定的限制。第一个限制是不能编写
Foo
的catchall实例。因此，对于要转换的每种类型，即使转换只是
id
，也需要
Foo
的实例。第二个限制是
CIO
无法编写，因为
IO
包装了所有内容。因此，这只适用于返回
IO（）
的内容。如果您希望它对返回
IO Int
的内容起作用，您也需要添加该实例

我怀疑只要有足够的工作和一些类型转换技巧，这些限制是可以克服的。但代码本身就够可怕的了，所以我不推荐它

有没有可能让一个函数在外部函数的某些参数为CString的情况下接受外部函数调用，并返回一个接受字符串的函数

你问，这可能吗

答案是：是的！哈斯克尔可以做到。

好的，幸好我们把事情弄清楚了

准备一些繁琐的手续：

{-#语言灵活上下文}
{-#语言灵活实例}
{-#语言MultiParamTypeClasses}
{-#语言类型族{-}
{-#语言不可判定实例}

啊，不过没那么糟。妈妈，看，没有重叠

这个问题似乎适用于IO函数，因为所有转换为CString（如newCString或withCString）的东西都是IO

对。这里要注意的是，我们需要关注两个相互关联的问题：两种类型之间的对应关系，允许转换；以及通过执行转换引入的任何额外上下文。为了充分处理这一问题，我们将使这两个部分显式化，并适当地重新排列。我们还需要o注意差异；提升整个函数需要使用协变和逆变位置的类型，因此我们需要在两个方向进行转换

现在，考虑到我们希望翻译的功能，计划如下：

• 转换函数的参数，接收新类型和一些上下文
• 将上下文延迟到函数的结果上，以获得我们想要的参数
• 尽可能折叠冗余上下文
• 递归地转换函数的结果，以处理多参数函数

嗯，听起来不太难。首先，明确的上下文：

class（函子f，cxtt~f）=>Context（f:：*->*）t其中
类型t:：*
类型Cxt:：*->*
折叠：：t->折叠t

这意味着我们有一个上下文

f

，还有一些类型

t

与该上下文相关。

Cxt

type函数从

t

中提取普通上下文，如果可能，

Collapse

尝试组合上下文。

Collapse

函数允许我们使用type函数的结果

现在，我们有纯上下文，并且

IO

：

newtype purecxta=purecxta{unwrapPure:：a}
实例上下文IO（IO（PureCxt a））其中
类型折叠（IO（pureCxtA））=IO a
类型Cxt（IO（PureCxt a））=IO
折叠=fmap展开
{-此处有更多实例…-}

足够简单。处理各种上下文组合有点乏味，但实例很明显，也很容易编写

我们还需要一种方法来确定给定要转换的类型的上下文。目前，上下文在两个方向上都是相同的，但可以肯定的是，它在其他方向上是相同的，所以我将它们分开处理。因此，我们有两个类型族，为导入/导出转换提供新的最外层上下文：

类型族ExpCxt int:：*->*
类型系列ImpCxt:：*->*

以下是一些示例：

type instance ExpCxt（）=PureCxt
类型实例ImpCxt（）=PureCxt
类型实例ExpCxt String=IO
类型实例ImpCxt CString=IO

下一步，转换单个类型。稍后我们将讨论递归。是时候使用另一个类型类了：

class（外部int~ext，本机ext~int）=>转换外部int，其中
输入外部int:：*
键入本机ext:：*
toForeign:：int->ExpCxt int ext
音调：：ext->ImpCxt-int

这意味着两种类型

ext

和

int

可以唯一地相互转换

{-# LANGUAGE TemplateHaskell #-}
--  test.hs
import FFiImport
import Foreign.C

foreign_1 :: CDouble -> CString -> CString -> IO CString
foreign_2 :: CDouble -> CString -> CString -> IO (Int,CString)
foreign_3 :: CString -> IO ()

foreign_1 = undefined; foreign_2 = undefined; foreign_3 = undefined

fmap concat (mapM ffimport ['foreign_1, 'foreign_2, 'foreign_3])

imported_foreign_1 :: Double -> String -> String -> IO String
imported_foreign_2 :: Double -> String -> String -> IO (Int, String)
imported_foreign_3 :: String -> IO ()

imported_foreign_2 w x y
  = (\ (a, b) -> ((return (,) `ap` return a) `ap` peekCString b) =<<
     join
       (((return foreign_2 `ap`
          (return . (realToFrac :: Double -> CDouble)) w) `ap`
         newCString x) `ap`
        newCString y))

imported_foreign_2 w x y = do
       w2 <- return . (realToFrac :: Double -> CDouble) w
       x2 <- newCString x
       y2 <- newCString y
       (a,b) <- foreign_2 w2 x2 y2
       a2 <- return a
       b2 <- peekCString b
       return (a2,b2) 

{-# LANGUAGE TemplateHaskell #-}
-- FFiImport.hs
module FFiImport(ffimport) where
import Language.Haskell.TH; import Foreign.C; import Control.Monad

-- a couple utility definitions

-- args (a -> b -> c -> d) = [a,b,c]
args (AppT (AppT ArrowT x) y) = x : args y
args _ = []

-- result (a -> b -> c -> d) = d
result (AppT (AppT ArrowT _) y) = result y
result y = y

-- con (IO a) = IO
-- con (a,b,c,d) = TupleT 4
con (AppT x _) = con x
con x = x

-- conArgs (a,b,c,d) = [a,b,c,d]
-- conArgs (Either a b) = [a,b]
conArgs ty = go ty [] where
    go (AppT x y) acc = go x (y:acc)
    go _ acc = acc

-- Possibly useful to parameterize based on conv'
ffimport :: Name -> Q [Dec]
ffimport n = do
    VarI _ ntype _ _ <- reify n

    let ty :: [Type]
        ty = args ntype

    let -- these define conversions
        --   (ffiType, (hsType -> IO ffiType, ffiType -> IO hsType))
        conv' :: [(TypeQ, (ExpQ, ExpQ))]
        conv' = [
            ([t| CString |], ([| newCString |],
                              [| peekCString |])),
            ([t| CDouble |], ([| return . (realToFrac :: Double -> CDouble) |],
                              [| return . (realToFrac :: CDouble -> Double) |]))
            ]

        sequenceFst :: Monad m => [(m a, b)] -> m [(a,b)]
        sequenceFst x = liftM (`zip` map snd x) (mapM fst x)

    conv' <- sequenceFst conv'
    -- now    conv' :: [(Type, (ExpQ, ExpQ))]

    let conv :: Type -- ^ type of v
             -> Name -- ^ variable to be converted
             -> ExpQ
        conv t v
            | Just (to,from) <- lookup t conv' =
                [| $to $(varE v) |]
            | otherwise = [| return $(varE v) |]

        -- | function to convert result types back, either
        --  occuring as IO a, IO (a,b,c)   (for any tuple size)
        back :: ExpQ
        back
            |   AppT _ rty <- result ntype,
                TupleT n <- con rty,
                n > 0, -- for whatever reason   $(conE (tupleDataName 0))
                       -- doesn't work when it could just be  $(conE '())
                convTup <- map (maybe [| return |] snd .
                                    flip lookup conv')
                                    (conArgs rty)
                                 = do
                    rs <- replicateM n (newName "r")
                    lamE [tupP (map varP rs)]
                        [| $(foldl (\f x -> [| $f `ap` $x |])
                              [| return $(conE (tupleDataName n)) |]
                              (zipWith (\c r -> [| $c $(varE r)|]) convTup rs))
                        |]
            |   AppT _ nty <- result ntype,
                Just (_,from) <- nty `lookup` conv' = from
            | otherwise = [| return |]

    vs <- replicateM (length ty) (newName "v")

    liftM (:[]) $
        funD (mkName $ "imported_"++nameBase n)
         [clause
            (map varP vs)
            (normalB [| $back =<< join
                        $(foldl (\x y -> [| $x `ap` $y |])
                                [| return $(varE n) |]
                                (zipWith conv ty vs))
                |])
            []]