是否有可能有一个函数接受外部函数调用，其中一些外部函数的参数是CString并返回一个接受String的函数？
以下是我正在寻找的一个例子：
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函数，因为转换为CStrings的所有内容（如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))
答案 0 :(得分：16)
答案 1 :(得分：7)
这可以使用模板haskell完成。在许多方面它比它更简单 涉及类的替代方案，因为它更容易进行模式匹配 Language.Haskell.TH.Type与实例相同。
{-# 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 ()
通过使用-ddump-splices加载test.hs来检查生成的代码（请注意 ghc似乎仍然错过了漂亮印刷中的一些括号） foreign_2写了一个定义，经过一些调整后看起来像：
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)
第一种方式生成代码更简单，因为变量更少 跟踪。虽然foldl（$）f [x，y，z]没有键入检查它的意思 （（f $ x）$ y $ z）= f x y z 它在模板haskell中是可以接受的，它只涉及少数不同的 类型。
现在实际实施这些想法：
{-# 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
splice $（ffimport'external_2）通过reify查看foreign_2的类型 决定应用于参数或结果的函数。
-- 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))
|])
[]]
答案 2 :(得分：4)
这是一个可怕的两个类型类解决方案。第一部分（名称无用，foo）将采用Double -> Double -> CString -> IO ()等类型的内容，并将其转换为IO (Double -> IO (Double -> IO (String -> IO ())))之类的内容。因此，为了使事情完全统一，每次转换都被强制转换为IO。
第二部分（名为cio for“collapse io”）将采用这些内容并将所有IO位推到最后。
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的内容，您还需要添加该实例。
我怀疑，只要有足够的工作和某些类型的诡计，就可以克服这些限制。但是代码很可怕，所以我不推荐它。
答案 3 :(得分：0)
这绝对有可能。通常的方法是创建lambdas以传递给withCString。使用您的示例：
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)