IORef Int <-> Ptr CInt in FFI

test.cpp

#include "test.h"

void mutateint( int* p ) 
{ 
  (*p) = 10 ; 
}

test.h

#ifdef __cplusplus
extern "C" { 
#endif

void mutateint (int* p );

#ifdef __cplusplus
}
#endif

testptr.hsc

{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}

module Main where

import Data.IORef
import Foreign.Ptr 
import Foreign.C
import Foreign.Storable
import Foreign.Marshal.Alloc
import Foreign.Marshal.Utils
import System.IO.Unsafe 

foreign import ccall "test.h mutateint" c_mutateint
  :: (Ptr CInt) -> IO ()

class Castable a b where
  cast :: a -> b 
  uncast :: b -> a 

class WrapRef a b where
  createRawRef :: a -> IO b 
  wrapRawRef :: b -> a -> IO () 

instance Castable () () where
  cast = id 
  uncast = id 

instance WrapRef (IORef Int) (Ptr CInt) where
  createRawRef ref = do 
    val <- readIORef ref  
    ptr <- new (fromIntegral val)
    return ptr 
  wrapRawRef ptr ref = do 
    val <- peek ptr 
    writeIORef ref (fromIntegral val)
    free ptr 
    
{-
xform1 :: (Castable x1 cx1, Castable y cy) 
       => (cx1 -> IO cy) -> x1 -> IO y
xform1 f x1 = f (cast x1) >>= return . uncast -}

xform1WithWrap :: (WrapRef x1 cx1, Castable y cy)
               => (cx1 -> IO cy) -> x1 -> IO y
xform1WithWrap f x1 = do 
  cx1 <- createRawRef x1 
  cy <- f cx1
  wrapRawRef cx1 x1 
  return . uncast $ cy 

mutateint :: IORef Int -> IO ()
mutateint = xform1WithWrap c_mutateint

main = do 
  putStrLn "foreign ptr <-> IORef test"
  nref <- newIORef (0 :: Int)
  mutateint nref 
  n <- readIORef nref
  putStrLn $ show n

Not yet working well.

Now it works with WrapRef class and instances.