Issue73.chs

module Main where

import Control.Monad
import Foreign
import Foreign.C

#include "issue73.h"

-- * withForeignPtr and newForeignPtr_ for foreign pointer hooks

{#pointer *test_struct3 as TestForeign1Ptr foreign#}
{#fun make_struct3 as foreign1MakeStruct {} -> `TestForeign1Ptr'#}
{#fun access_struct3 as foreign1Access {`TestForeign1Ptr'} -> `Int'#}

foreign1 :: IO ()
foreign1 = do
  foreignPtr <- foreign1MakeStruct
  foreignVal <- foreign1Access foreignPtr
  putStrLn $ "Foreign pointer: " ++ show foreignVal


{#pointer *test_struct3 as TestForeign2Ptr foreign finalizer free_struct3#}
{#fun make_struct3 as foreign2MakeStruct {} -> `TestForeign2Ptr'#}
{#fun access_struct3 as foreign2Access {`TestForeign2Ptr'} -> `Int'#}

foreign2 :: IO ()
foreign2 = do
  foreignPtr <- foreign2MakeStruct
  foreignVal <- foreign2Access foreignPtr
  putStrLn $ "Foreign pointer: " ++ show foreignVal


-- * withPointerType (the generated function) and
--   PointerType . newForeignPtr_ for foreign newtype pointer
--   hooks. The out marshaller is not great here, a !ForeignPtr with
--   no finalizers is not terribly useful concealed inside the
--   newtype. Perhaps foreign newtype should be left naked, or
--   furnished with an 'in' default marshaller only.

{#pointer *test_struct4 as TestForeignNt1Ptr foreign newtype#}
{#fun make_struct4 as foreignNt1MakeStruct {} -> `TestForeignNt1Ptr'#}
{#fun access_struct4 as foreignNt1Access {`TestForeignNt1Ptr'} -> `Int'#}

foreignNt1 :: IO ()
foreignNt1 = do
  foreignNtPtr <- foreignNt1MakeStruct
  foreignNtVal <- foreignNt1Access foreignNtPtr
  putStrLn $ "Foreign newtype pointer: " ++ show foreignNtVal
  return ()


{#pointer *test_struct4 as TestForeignNt2Ptr
                           foreign finalizer free_struct4 newtype#}
{#fun make_struct4 as foreignNt2MakeStruct {} -> `TestForeignNt2Ptr'#}
{#fun access_struct4 as foreignNt2Access {`TestForeignNt2Ptr'} -> `Int'#}

foreignNt2 :: IO ()
foreignNt2 = do
  foreignNtPtr <- foreignNt2MakeStruct
  foreignNtVal <- foreignNt2Access foreignNtPtr
  putStrLn $ "Foreign newtype pointer: " ++ show foreignNtVal
  return ()


main :: IO ()
main = do
  foreign1
  foreign2
  foreignNt1
  foreignNt2
  return ()