Skip to content

#get and #set don't accept newtyped pointers #96

Closed
@RyanGlScott

Description

@RyanGlScott

Trying to use #pointer's newtype feature with #get and #set is inconvenient at the moment. For example,

{-# LANGUAGE ForeignFunctionInterface #-}
module NewtypeGetSet where

import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable

#c
typedef struct {
    int x;
    int y;
} foo_t;

void simple_func(foo_t *f);
#endc

{#pointer *foo_t as FooPtr newtype #}

get :: FooPtr -> IO CInt
get = {#get foo_t.x #}

set :: FooPtr -> CInt -> IO ()
set = {#set foo_t.x #}

call :: FooPtr -> IO ()
call = {#call simple_func #}

c2hs will translate this to:

-- GENERATED by C->Haskell Compiler, version 0.17.2 Crystal Seed, 24 Jan 2009 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "NewtypeGetSet.chs" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
module NewtypeGetSet where

import Foreign.C.Types
import Foreign.Ptr
import Foreign.Storable

newtype FooPtr = FooPtr (Ptr (FooPtr))
{-# LINE 16 "NewtypeGetSet.chs" #-}


get :: FooPtr -> IO CInt
get = (\ptr -> do {peekByteOff ptr 0 ::IO CInt})
{-# LINE 19 "NewtypeGetSet.chs" #-}


set :: FooPtr -> CInt -> IO ()
set = (\ptr val -> do {pokeByteOff ptr 0 (val::CInt)})
{-# LINE 22 "NewtypeGetSet.chs" #-}


call :: FooPtr -> IO ()
call = simple_func
{-# LINE 25 "NewtypeGetSet.chs" #-}

foreign import ccall safe "NewtypeGetSet.chs.h simple_func"
  simple_func :: ((FooPtr) -> (IO ()))

This is a problem, since peekByteOff and pokeByteOff both expect an argument of type Ptr a, which FooPtr is not. In order to fix this, you'd have to manually pattern-match against FooPtr, e.g.,

get :: FooPtr -> IO CInt
get (FooPtr p) = {#get foo_t.x #} p

set :: FooPtr -> CInt -> IO ()
set (FooPtr p) = {#set foo_t.x #} p

which is a bit annoying, especially since #call and #fun automate the necessary plumbing for you.

Metadata

Metadata

Assignees

No one assigned

    Labels

    Type

    No type

    Projects

    No projects

    Milestone

    No milestone

    Relationships

    None yet

    Development

    No branches or pull requests

    Issue actions