language-c-inline-0.7.11.0: Inline C & Objective-C code in Haskell for language interoperability

Copyright[2013..2016] Manuel M T Chakravarty
LicenseBSD3
MaintainerManuel M T Chakravarty <chak@cse.unsw.edu.au>
Stabilityexperimental
Portabilitynon-portable (GHC extensions)
Safe HaskellNone
LanguageHaskell98

Language.C.Inline.ObjC

Contents

Description

This module exports the principal API for inline Objective-C.

Synopsis

Re-export types from C

type CString = Ptr CChar #

A C string is a reference to an array of C characters terminated by NUL.

type CStringLen = (Ptr CChar, Int) #

A string with explicit length information in bytes instead of a terminating NUL (allowing NUL characters in the middle of the string).

type CWString = Ptr CWchar #

A C wide string is a reference to an array of C wide characters terminated by NUL.

type CWStringLen = (Ptr CWchar, Int) #

A wide character string with explicit length information in CWchars instead of a terminating NUL (allowing NUL characters in the middle of the string).

data Errno :: * #

Haskell representation for errno values. The implementation is deliberately exposed, to allow users to add their own definitions of Errno values.

Instances

Eq Errno 

Methods

(==) :: Errno -> Errno -> Bool #

(/=) :: Errno -> Errno -> Bool #

data ForeignPtr a :: * -> * #

The type ForeignPtr represents references to objects that are maintained in a foreign language, i.e., that are not part of the data structures usually managed by the Haskell storage manager. The essential difference between ForeignPtrs and vanilla memory references of type Ptr a is that the former may be associated with finalizers. A finalizer is a routine that is invoked when the Haskell storage manager detects that - within the Haskell heap and stack - there are no more references left that are pointing to the ForeignPtr. Typically, the finalizer will, then, invoke routines in the foreign language that free the resources bound by the foreign object.

The ForeignPtr is parameterised in the same way as Ptr. The type argument of ForeignPtr should normally be an instance of class Storable.

Instances

Eq (ForeignPtr a) 

Methods

(==) :: ForeignPtr a -> ForeignPtr a -> Bool #

(/=) :: ForeignPtr a -> ForeignPtr a -> Bool #

Data a => Data (ForeignPtr a) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ForeignPtr a -> c (ForeignPtr a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (ForeignPtr a) #

toConstr :: ForeignPtr a -> Constr #

dataTypeOf :: ForeignPtr a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (ForeignPtr a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (ForeignPtr a)) #

gmapT :: (forall b. Data b => b -> b) -> ForeignPtr a -> ForeignPtr a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ForeignPtr a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ForeignPtr a -> r #

gmapQ :: (forall d. Data d => d -> u) -> ForeignPtr a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> ForeignPtr a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> ForeignPtr a -> m (ForeignPtr a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> ForeignPtr a -> m (ForeignPtr a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> ForeignPtr a -> m (ForeignPtr a) #

Ord (ForeignPtr a) 
Show (ForeignPtr a) 

castForeignPtr :: ForeignPtr a -> ForeignPtr b #

This function casts a ForeignPtr parameterised by one type into another type.

Re-export types from Template Haskell

data Name :: * #

An abstract type representing names in the syntax tree.

Names can be constructed in several ways, which come with different name-capture guarantees (see Language.Haskell.TH.Syntax for an explanation of name capture):

  • the built-in syntax 'f and ''T can be used to construct names, The expression 'f gives a Name which refers to the value f currently in scope, and ''T gives a Name which refers to the type T currently in scope. These names can never be captured.
  • lookupValueName and lookupTypeName are similar to 'f and ''T respectively, but the Names are looked up at the point where the current splice is being run. These names can never be captured.
  • newName monadically generates a new name, which can never be captured.
  • mkName generates a capturable name.

Names constructed using newName and mkName may be used in bindings (such as let x = ... or x -> ...), but names constructed using lookupValueName, lookupTypeName, 'f, ''T may not.

Instances

Eq Name 

Methods

(==) :: Name -> Name -> Bool #

(/=) :: Name -> Name -> Bool #

Data Name 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Name -> c Name #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c Name #

toConstr :: Name -> Constr #

dataTypeOf :: Name -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c Name) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Name) #

gmapT :: (forall b. Data b => b -> b) -> Name -> Name #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Name -> r #

gmapQ :: (forall d. Data d => d -> u) -> Name -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Name -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Name -> m Name #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Name -> m Name #

Ord Name 

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

(>=) :: Name -> Name -> Bool #

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

Show Name 

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

Generic Name 

Associated Types

type Rep Name :: * -> * #

Methods

from :: Name -> Rep Name x #

to :: Rep Name x -> Name #

Ppr Name 

Methods

ppr :: Name -> Doc #

ppr_list :: [Name] -> Doc #

IsType Name # 

Methods

theType :: Name -> Q Type

type Rep Name 

Objective-C memory management support

objc_retain :: Ptr a -> IO (Ptr a) #

objc_release :: Ptr a -> IO () #

newForeignClassPtr :: Ptr a -> IO (ForeignPtr a) #

Turn a retainable Objective-C pointer into a foreign pointer that is released when finalised.

NB: We need to retain the pointer first as it won't come with a +1 retain count for Haskell land to consume (at best, it will have an autoreleased +1 if it is a function return result).

newForeignStructPtr :: Ptr a -> IO (ForeignPtr a) #

Turn a non-retainable C pointer into a foreign pointer that is freed when finalised.

Combinators for inline Objective-C

objc_import :: [FilePath] -> Q [Dec] #

Specify imported Objective-C files. Needs to be spliced where an import declaration can appear. (Just put it straight after all the import statements in the module.)

NB: This inline splice must appear before any other use of inline code in a module.

FIXME: need to use TH.addDependentFile on each of the imported ObjC files & read headers

objc_interface :: [Definition] -> Q [Dec] #

Inline Objective-C top-level definitions for a header file ('.h').

objc_implementation :: [Annotated Name] -> [Definition] -> Q [Dec] #

Inline Objective-C top-level definitions for an implementation file ('.m').

The top-level Haskell variables given in the first argument will be foreign exported to be accessed from the generated Objective-C code. In C, these Haskell variables will always be represented as functions. (In particular, if the Haskell variable refers to a CAF, it will be a nullary function in C — after all, a thunk may still need to be evaluated.)

objc_record #

Arguments

:: String

prefix of the class name

-> String

class name

-> Name

name of the Haskell type of the bridged Haskell structure

-> [Annotated Name]

Haskell variables used in Objective-C code

-> [PropertyAccess]

Objective-C properties with corresponding Haskell projections and update functions

-> [ObjCIfaceDecl]

extra interface declarations

-> [Definition]

extra implementation declarations

-> Q [Dec] 

Specification of a bridge for a Haskell structure that can be queried and updated from Objective-C.

The first argument is the name of the Objective-C class that will be a proxy for the Haskell structure. The second argument the name of the Haskell type of the bridged Haskell structure.

The generated class is immutable. When a property is updated, a new instance is allocated. This closely mirrors the behaviour of the Haskell structure for which the class is a proxy.

The designated initialiser of the generated class is '[-initWithHsNameHsPtr:(HsStablePtr)particleHsPtr]', where '<HsName>' is the type name of the Haskell structure. This initialiser is generated if it is not explicitly provided. The generated method '[-init]' calls the designated initialiser with nil for the stable pointer.

WARNING: This is a very experimental feature and it will SURELY change in the future!!!

FIXME: don't generate the designated initialiser if it is explicitly provided

objc_class_marshaller :: Name -> Name -> Q [Dec] #

Declare a Haskell-Objective-C marshaller pair to be used in all subsequent marshalling code generation.

On the Objective-C side, the marshallers must use a wrapped foreign pointer to an Objective-C class (just as those of Class hints). The domain and codomain of the two marshallers must be the opposite and both are executing in IO.

objc_struct_marshaller :: Name -> Name -> Q [Dec] #

Declare a Haskell-Objective-C marshaller pair to be used in all subsequent marshalling code generation.

On the Objective-C side, the marshallers must use a wrapped foreign pointer to an C struct (just as those of Struct hints). The domain and codomain of the two marshallers must be the opposite and both are executing in IO.

objc_typecheck :: Q [Dec] #

Force type checking of all declaration appearing earlier in this module.

Template Haskell performs type checking on declaration groups seperated by toplevel splices. In order for a type declaration to be available to an Objective-C inline directive, the type declaration must be in an earlier declaration group than the Objective-C inline directive. A toplevel Objective-C inline directive always is the start of a new declaration group; hence, it can be considered to be implicitly preceded by an objc_typecheck.

objc :: [Annotated Name] -> Annotated Exp -> Q Exp #

Inline Objective-C expression.

The inline expression will be wrapped in a C function whose arguments are marshalled versions of the Haskell variables given in the first argument. The marshalling of the variables and of the result is determined by the marshalling annotations at the variables and the inline expression.

objc_emit :: Q [Dec] #

Emit the Objective-C file and return the foreign declarations. Needs to be the last use of an 'objc...' function. (Just put it at the end of the Haskell module.)

Marshalling annotations

data Annotated e where #

Annotating entities with hints.

The alternatives are to provide an explicit marshalling hint with '(:>)', or to leave the marshalling implicitly defined by the name's type.

Constructors

(:>) :: Hint hint => e -> hint -> Annotated e 
Typed :: Name -> Annotated Name 

(<:) :: Hint hint => hint -> e -> Annotated e #

We provide additional syntax where the hint is to the left of the annotated entity.

void :: e -> Annotated e #

Annotation for irrelevant results

data Class where #

Hint indicating to marshal an Objective-C object as a foreign pointer, where the argument is the Haskell type representing the Objective-C class. The Haskell type name must coincide with the Objective-C class name.

Constructors

Class :: IsType t => t -> Class 

data Struct where #

Hint indicating to marshal a pointer to a C struct as a foreign pointer, where the argument is the Haskell type representing the C type name. The Haskell type name must coincide with the C type name.

NB: This is like Class with the difference that finalisers on foreign pointers created during marshalling use free rather than release.

Constructors

Struct :: IsType t => t -> Struct 

class IsType ty #

Class of entities that can be used as TH types.

Minimal complete definition

theType

Instances

IsType Type # 

Methods

theType :: Type -> Q Type

IsType Name # 

Methods

theType :: Name -> Q Type

IsType (Q Type) # 

Methods

theType :: Q Type -> Q Type

Property maps

data PropertyAccess #

Maps a quoted property to a quoted projection and a quoted update function in addition to the type of the projected value.

(==>) :: ObjCIfaceDecl -> (TypeQ, ExpQ, ExpQ) -> PropertyAccess #

Map a property to explicit projection and update functions.

(-->) :: ObjCIfaceDecl -> Name -> PropertyAccess #

Map a property to a field label. This function assumes that the field name is typed and can be reified.