Thursday 18 February 2010

A small Haskell / Objective-C Interface


In this post I will present a small Haskell typeclass OBJC for interfacing with Objective-C. Instead of implementing an interface via proxy types, OBJC will provide two functions toId and fromId. These can be used to transfer native Objective-C values to corresponding native Haskell value. It means for example converting a NSString to a Haskell String value or a NSArray to a Haskell list. The conversion via OBJC also works for more complex data structures, like e.g. [(Int, String)].

The use case for this typeclass would be to define a Haskell model implementation in a Cocoa Model-View-Controller application. This way the communication between the Haskell model and the Objective-C controller can be made easier and the programmer is able to define the model directly in terms of Haskell types.

For testing I also provide a simple application that shows how to use the OBJC typeclass in a Cocoa application.

Introduction

In the last post I described a technique to build a simple Cocoa application that interacts with Haskell. In this Cocoa application (Apple’s famous Currency Converter tutorial) all that was passed were plain scalar values, namely the double values for exchange rate, dollar amount, and the result. Passing C scalar values is made easy, because they are handled by Haskell’s Foreign Function Interface out of the box. The FFI also helps us to pass stable opaque references of Haskell values back to C by providing the StablePtr type.

In this post we will extend this simple interface to more data types. We will get a corresponding type to StablePtr for storing Objective-C objects in Haskell values in a stable way. Additionally we will create instances of OBJC for basic data types, like numbers, strings, and arrays. The template for this typeclass was the JSON typeclass that is described in chapter 6 of Real World Haskell.

This approach focusses on providing help for defining Haskell models for Cocoa applications. The rest of the application will still be implemented in Objective-C. For a complete implementation of a Cocoa application in Haskell HOC would be a good choice.

For the development of the OBJC typeclass we will switch back to reference counting on the Objective-C side. Dealing with two garbage collectors in two runtimes is hard. One of these runtimes might be heavily threaded because of Grand Central Dispatch; the other one uses lazy evaluation as default. Not exactly the kind of environment you want to play with if you are just starting. It’s not easy to be sure: is this object still reachable? When will it be evaluated and will it still be there? The ideal recipe for some headaches! So therefore it’s best to eliminate at least one cause for potential problems and switch back to reference-counting (retain/release) on the Objective-C side. Maybe I am too cautious, maybe it all works fine using the Objective-C GC, but for a start we will just take the simple approach.

The OBJC typeclass

The basic Objective-C class is NSObject and a pointer to a NSObject instance is of type id. We would like to pass NSObjects to Haskell functions as arguments or to return them as a result of a function. On the Haskell side it would be nice if basic types, like e.g. arrays or strings, could be automatically converted to the corresponding Objective-C types and vice versa.

For tasks like this it is best to define a typeclass in Haskell:

class OBJC a where
    fromId :: Id -> IOOBJC a
    toId   :: a  -> IOOBJC Id

This means that an instance a of the typeclass OBJC will provide a function fromId that converts Objective-C ids to a and a function toId that does the backward conversion, providing an Objective-C object for an a value.

The Objective-C pointers are represented in Haskell by the type Id:

data ObjcObject
type Id = Ptr ObjcObject    -- typed pointer for all NSObjects 

This is a typed pointer and can never be dereferenced.1 The type ObjcObject is an empty data declaration: there is no way in Haskell to construct a value of the type ObjcObject, which is ok as Objective-C objects are constructed by the Objective-C runtime. In order to use empty data declarations we have to switch on the GHC extension EmptyDataDecls.

Now a closer look at the result types of the typeclass functions: toId will provide a new Id for a given a value. This new Id will be an Objective-C value and means, that we will have to call the Objective-C runtime and maybe construct a new object. This clearly implies, that we have to do some IO and therefore this function will run in the IO monad, meaning that calling this functions will have side effects, namely the construction of a new Objective-C object. Just what we wanted.

The other function fromId will also call the Objective-C runtime and as Objective-C objects are not immutable per se calling the function fromId might give different results even if we provide the same id as an argument (for example, think of NSMutableArray). So this function has to be run in the IO monad too.

But the conversion from an Id value to an a value might result in an error. This is because we are doing a conversion from a weakly typed language to a strongly typed one.2 We have to deal with this. Therefore the function fromId runs in the IOOBJC monad, which is the IO monad plus error handling. It is defined as:

type OBJCError = String
type IOOBJC = ErrorT OBJCError IO

Using the ErrorT monad transformer. Inside this monad we can throw an error by the throwError action in case something goes wrong.3 Although it might strictly be not necessary4, we will use the IOOBJC monad for the toId function also, because this way the resulting code involving both fromId and toId will look nicer.

Opaque Values — The basic instance StableId

The first instance of the OBJC typeclass will be StableId. This is the counterpart of the StablePtr from the FFI. Where the StablePtr provides a way to store an opaque reference to a Haskell value in Objective-C and making sure that the referenced value will not be garbage collected, the StableId will provide a way to store an opaque Objective-C object in Haskell. It will make sure, that this object will not be dealloced by Objective-C as long as Haskell holds a reference to this object.

In order to deal with foreign-managed objects we have to use the ForeignPtr data type as the documentation explains:

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.

Therefore we define:

newtype StableId = StableId {
      foreignPtr :: ForeignPtr ObjcObject
    }

This type shall be an instance of the OBJC typeclass:

instance OBJC StableId where
    toId x = liftIO $ 
             withForeignPtr (foreignPtr x) $ 
                \ptr -> c_retainId ptr >>= c_autoreleaseId

    fromId ptr = liftIO $ 
                 do x <- c_retainId ptr >>= newForeignPtr c_FunPtr_releaseId 
                    return $ StableId x

In fromId we create a new ForeignPtr from a given Id. This is done by x <- c_retainId ptr >>= newForeignPtr c_FunPtr_releaseId: first the Id value is retained by c_retainId and then a new ForeignPtr is created with an associated finalizer c_FunPtr_releaseId. This means, first Haskell increases the retain count of the transferred object such that the Objective-C runtime wont dealloc the object as long as Haskell holds a reference to it via the ForeignPtr. This object is then released —once the Haskell runtime has no longer a reference to it— using the mechanism of the ForeignPtr and the provided finalizer c_FunPtr_releaseId. These functions are defined in Objective-C as:

void releaseId(id object)
{
    // release can trigger dealloc, which might need an autorelease pool
    NSAutoreleasePool *pool = [[NSAutoreleasePool alloc] init];
    [object release];
    [pool release];
}

id retainId(id object)
{
    return [object retain];
}

id autoreleaseId(id object)
{
    return [object autorelease];
}

The toId function is similar: we just retrieve the stored pointer to the Objective-C object and return it to the Objective-C runtime. Before that, we make sure that the returned object will not be dealloced by sending a retain and autorelease message to it via the Objective-C runtime.

The StableId instance of OBJC can deal with every sub-class of NSObject. It provides an opaque storage for objects of these Objective-C classes just like the StablePtr on the C side.

Numbers

For dealing with C scalar number types like double or int the FFI provides the necessary mechanisms. But the C number types are not first-class values in Objective-C. So, for example, you cannot store them in a NSArray.5 The first-class wrapper around C numbers is NSNumber. In the following we will construct instances for Int and Double of OBJC that can convert to and from NSNumber values.

The definition of the numeric instances for OBJC is quite straightforward: first we define a helper function that checks if a given Id represents a NSNumber object and if so calls a function f :: (OBJC a) => (Id -> IO a) to do the real conversion of this NSNumber to a numeric value in Haskell:

checkIfNSNumber :: (OBJC a) => (Id -> IO a) -> Id -> IOOBJC a
checkIfNSNumber f ptr = do isNSNumber <- liftIO $ c_isNSNumber ptr
                           case (fromIntegral isNSNumber) of
                             0         -> throwError "not a NSNumber value"
                             otherwise -> liftIO $ f ptr

The C helper function is given as:

int isNSNumber(id object)
{
    if ([object isKindOfClass:[NSNumber class]]) 
        return 1;
    else 
        return 0;
}

We are passing back int values instead of BOOL, because the FFI does not provide a wrapper for boolean values.

With this we can now define the OBJC instances for Double and Int:

instance OBJC Double where
    toId = checkNullPtr "Could not create NSNumber" . 
           c_numberWithDouble . realToFrac

    fromId = checkIfNSNumber $ liftM realToFrac . c_doubleValue

instance OBJC Int where
    toId = checkNullPtr "Could not create NSNumber" . 
           c_numberWithLong . fromIntegral

    fromId = checkIfNSNumber $ liftM fromIntegral . c_longValue

The function checkNullPtr is a simple function to lift an IO action to the IOOBJC monad. It will throw an error if a nullPtr is passed. This function is given as:

checkNullPtr :: String -> IO Id -> IOOBJC Id
checkNullPtr msg act = do ptrId <- liftIO act
                          if ptrId == nullPtr
                             then throwError msg
                             else return ptrId

Additionally we have the C conversion functions, here are the functions for Double:

double doubleValue(NSNumber *aNumber)
{
    return [aNumber doubleValue];
}

NSNumber *numberWithDouble(double aDouble)
{
    return [NSNumber numberWithDouble:aDouble];
}

This way basically all numeric values can be made into instances of OBJC.6

Strings

In Haskell we have the luxury of being provided with unicode strings. Same goes for Objective-C’s NSString class. The only problem is that we have to interface via C’s old ASCII strings. But this can be dealt with by using the nice Data.Text7 package in combination with Data.ByteString.

So in order to define an OBJC instance for String8 we proceed by “wishful thinking” and assume, that we already have an instance for Data.Text:

instance OBJC String where
    -- via Text
    toId = toId . T.pack
    fromId x = return . T.unpack =<< fromId x

T.pack and T.unpack are functions from Data.Text (imported qualified as T) that construct T.Text values from Strings and vice versa.

In toId = toId . T.pack the function on the left-hand side has the type String -> IOOBJC Id and toId on the right-hand side has the type T.Text -> IOOBJC Id. These a two different functions and the Haskell compiler knows what function to take just by inferring the used types.

We now define the instance for T.Text once again by wishful thinking:

instance OBJC T.Text where
    -- via ByteString
    toId = toId . encodeUtf8
    fromId x = return . decodeUtf8 =<< fromId x

The functions encodeUtf8 and decodeUtf8 are from Data.Text.Encoding and provide the translation from and to ByteStrings.

Finally there comes the point where we really have to deal with the conversion to Objective-C types. For this the ByteString module provides the necessary functions:

instance OBJC BS.ByteString where
    toId x = checkNullPtr "Could not create NSString" $ 
                            BS.useAsCString x c_utf8ToNSString

    fromId x = do ptr <- liftIO $ c_nsStringToUtf8 x
                  if ptr == nullPtr
                    then throwError "not a NSString value"
                    else liftIO $ BS.packCString ptr

For this we also need the corresponding C helper functions:

const char *nsStringToUtf8(NSString *str)
// returns a CString of UTF8 chars for the NSString str.
// if str is not a NSString, it will pass back NULL
{
    // it is quite time consuming to test at runtime if `str` really is a NSString.
    // so let's be optimistic and deal with an exception by passing back the null pointer.
    const char *p;
    @try {
        // according to the documentation of NSString's UTF8String the resulting
        // char array will be freed by the autorelease pool.
        p = [str UTF8String];
    }
    @catch (NSException * e) {
        p = NULL;
    }

    return p;
}

NSString *utf8ToNSString(const char* cstr)
{
    NSString *res;
    @try {
        res = [NSString stringWithUTF8String:cstr];
    }
    @catch (NSException * e) {
        res = NULL;
    }

    return res;
}

This way we can now construct three different types from a NSString: ByteString, Text, and String.

Arrays Lists

A more interesting data type is the array or list. (I know, arrays are not lists, but for the sake of this article I will use them both as representation of some abstract container type. For all that matters now, we can convert NSArrays to Haskell’s lists.)

An array contains other values, maybe even other arrays. So we cannot say in advance how deep the conversion has to be. But in principle we have to trigger the conversion of the complete nested structure contained in the array.

So the conversion of a container consists of two steps:

  1. Convert the original container value.

  2. (Recursively) Convert all contained values.

This can be done in Haskell quite nicely:

instance (OBJC a) => OBJC [a] where
    toId  xs = mapM toId xs >>= toNSArray'
    fromId x = fromNSArray' x >>= mapM fromId 

In fromId the function fromNSArray' has the type Id -> IOOBJC [Id]. It converts the original container NSArray to the Haskell list [Id] that contains the untreated Objective-C values of type Id. These values are then converted to Haskell values by mapM fromId. In the case of toId we have to execute the steps the other way around: first we have to convert all the values of a list (OBJC a) => [a] to [Id] which is done inside the IOOBJC monad by mapM toId and then convert the Haskell list to an NSArray by the function toNSArray' :: [Id] -> IOBJC Id.

These helper function toNSArray' and fromNSArray' are defined as local functions and we get the final implementation:

instance (OBJC a) => OBJC [a] where
    toId xs = mapM toId xs >>= toNSArray'
        where
          toNSArray' :: [Id] -> IOOBJC Id
          toNSArray' x = checkNullPtr "Could not create NSArray" $ 
                              withArrayLen x $ \len ptr -> 
                                  c_arrayWithCArray ptr (fromIntegral len)

    fromId x = fromNSArray' x >>= mapM fromId 
        where
          fromNSArray' :: Id -> IOOBJC [Id]
          fromNSArray' x = do ptr <- liftIO $ c_getObjects x
                              if ptr == nullPtr
                                then throwError "not a NSArray"
                                else liftIO $ do 
                                  len <- c_len x
                                  res <- peekArray (fromIntegral len) ptr
                                  free ptr
                                  return res

The restriction (OBJC a) => OBJC [a] says, that we can convert only lists that contain values of another OBJC instance. But this really is not that much of a restriction as we have the OBJC instance StableId that can be used for every NSObject value.

For the conversion of lists to C arrays we use the Foreign.Marshal.Array functions withArrayLen and peekArray. Finally here are the missing C helper functions:

NSArray *arrayWithCArray(id *objects, NSUInteger count)
{
    return [NSArray arrayWithObjects:objects count:count];
}

NSUInteger lengthOfArray(NSArray *anArray)
{
    NSUInteger len;
    @try {
        len = [anArray count];
    }
    @catch (NSException * e) {
        len = 0;
    }
    return len;
}

id *getObjects(NSArray *anArray)
{
    id (*objects);
    @try {
        NSRange range = NSMakeRange(0, [anArray count]);
        objects = malloc(sizeof(id) * range.length);
        [anArray getObjects:objects range:range];
    }
    @catch (NSException * e) {
        objects = NULL;
    }
    return objects;
}

The nice thing now is that we can trigger the depth of the conversion just by the type of the resulting OBJC instance! E.g. if we have a large NSArray of NSArrays of NSStrings we might not be interested in the individual strings on the Haskell side (we might just want to pass them back to Objective-C anyway). In this case we would use a conversion like fromId :: IOOBJC [StableId] and take, say, only the first element. But if we on the other hand really need all those strings nested in the structure we might use a conversion like fromId :: IOOBJC [[String]]. All just by specifying the result type.

Tuples

We now have the conversions for the basic data structures. The conversions for other data structures like e.g. NSDictionary can easily be defined along these lines. But as a last example we will look at the conversion for a Haskell tuple type, because this is kind of interesting.

Objective-C does not know tuples, in some sense NSArrays are tuples also. In Haskell one difference between tuples and lists is that tuples can contain values of different type. So if we want to define an instance of OBJC for a two-tuple we have to allow for that. This is expressed by the definition:

instance (OBJC a, OBJC b) => OBJC (a, b) where
    undefined

Here the type variables a and b might refer to different instances of OBJC. This means that types like (String, Double) would be an instance of OBJC, but also (String, String).

In order to make the definition of the instance for the two-tuple easy we would like to reuse old code. It would be nice if we could use the Haskell list to NSArray conversion as we finally want to convert the tuple to a NSArray anyway. But in Haskell a list can only contain values of the same type. So to make that work we will use StableId as a middleman and get:

instance (OBJC a, OBJC b) => OBJC (a, b) where
    -- via list and StableId
    toId (a, b) = do -- wrap arguments into opaque StableId, so that we can use them in a list
                     aStId <- fromId =<< toId a :: IOOBJC StableId
                     bStId <- fromId =<< toId b :: IOOBJC StableId
                     toId [aStId, bStId]

    fromId x = do ys <- fromId x :: IOOBJC [StableId]
                  case ys of
                      (aStId:bStId:[]) -> do a <- fromId =<< toId aStId
                                             b <- fromId =<< toId bStId
                                             return (a, b)
                      otherwise        -> throwError "Wrong number of arguments for (,)"

Implementations for longer tuples can be done the same way.

An example Cocoa application

For testing the OBJC typeclass I created a short Cocoa application. Its source is available as download.9 The mechanism how to use Haskell in an Objective-C application is described in my last blog post.

In this application mainly pure Haskell functions are tested. These are wrapped with the helper functions

toCocoa :: (OBJC a, OBJC b) => (a -> b) -> Id -> IO Id
toCocoa f anId = catchOBJC $ toId . f =<< fromId anId

catchOBJC :: IOOBJC Id -> IO Id
catchOBJC act = do eth <- runErrorT act
                   case eth of
                      Left err -> do nsLog $ "(Haskell) OBJC error: " ++ err
                                     return nullPtr
                      Right  y -> return y

With toCocoa the example “Array Test” is just defined as:

lengthOfStrings :: [String] -> [(Int, String)]
lengthOfStrings = map $ \x -> (length x, x)

foreign export ccall c_countAllStrings :: Id -> IO Id
c_countAllStrings = toCocoa lengthOfStrings

The toCocoa function automatically applies the necessary conversions for wrapping every function of type (OBJC a, OBJC b) => a -> b and makes it available to Objective-C!

Included are also two tests in which the execution of the Id -> IO Id function is paused by passing back a StablePtr to Objective-C. I did this, because I do not feel that comfortable with lazy evaluation. As a Haskell beginner, I find it generally quite difficult to tell which parts of an expression will be evaluated immediately and which parts will become thunks. This especially worries me, because in passing Objective-C values to Haskell we must make sure that we have handled these values on the Haskell side before they are released by the Objective-C runtime. So I wanted to test a typical scenario where one would store an OBJC instance value inside a Haskell data structure and pass a StablePtr to this value back to Objective-C.

Summary

We now have quite a nice way to convert Haskell values to Objective-C or the other way around:

Data StructureHaskell RepresentationObjective-C RepresentationRemarks
Opaque valueStableId by OBJCStablePtr from the FFI
Scalar numberInt, Double, …C types int, double, …Conversion by FFI
1st class numberInt, Double, …NSNumberConversion by OBJC
StringString, Data.TextNSStringConversion by OBJC
ContainerList, tupleNSArrayConversion by OBJC

It should be quite easy to expand this list for more data types, like e.g. NSDictionary.

But one does not necessary has to define own wrappers for every NSObject type, as one can just use the opaque type StableId and use Objective-C methods to deal with this object. In the provided source is an example (“String Test”) that shows how to send a simple message to an Objective-C object.

Conclusion

The combination of typeclasses with a strong type system offers a nice way to do quasi-automatic transformation of Objective-C values to Haskell values and vice versa. For example, pure Haskell functions of type (OBJC a, OBJC b) => (a -> b) can be made available for Objective-C just by wrapping them with toCocoa. Other functions types can be exposed easily as well.

Working on the typeclass was quite straightforward, even for a Haskell beginner like me. But I am convinced that the provided code is not written in the way that a Haskell expert would have written it.

Although I really enjoyed working on this typeclass, I feel a bit uneasy concerning lazy evaluation, as mentioned before in the chapter “An example Cocoa application”. Right now, all my test cases show no problems with lazy evaluation and object retaining/releasing. But this surely does not mean that all of this is safe in every possible situation. Reasoning about this non-strict behavior is for me so far the biggest problem in programming Haskell.

One last thing: Looking at the type of the tuple instance for OBJC, (OBJC a, OBJC b) => OBJC (a, b), and the types of functions as arguments to toCocoa, (OBJC a, OBJC b) => (a -> b), one notices that they look very similar.10 Maybe there is a sensible way to define an OBJC instance for these functions. On the Objective-C side we might have to define a new class, that will hold the original Haskell function, and that can invoke the stored function thereby automatically converting the argument to a Haskell value and the result back to an Objective-C value. Providing such an instance could help us to get rid of all those “dummy” C function definitions for the Haskell model.




  1. For details about typed pointers please consult chapter 17 of Real World Haskell.

  2. Think of converting a NSArray to a type [String]: it might be possible at compile time to deduce the array type, but in general it is impossible in Objective-C to tell the type of the contained elements in an array at compile time. It is even possible, that an Objective-C array contains objects of different types. So converting such an array to a Haskell list might result in a runtime error. This class of runtime errors are handled by the IOBJC monad.

  3. The IOOBJC just uses strings for the error. In a future version it might be better to use a dedicated instance of the Error typeclass as explained in chapter 19 of Real World Haskell.

  4. The kind of errors, that IOOBJC is used for, will not be thrown by toId, because in this case we are converting from a strongly typed language to a language with a weaker type system. So we are loosing information about the types. IOBJC is there to deal with errors, where we don’t have enough information about the types of the values at compile time.

  5. In Haskell numeric types are not only first-class citizens, but you can define your own numeric types and do quite interesting stuff as explained in chapter 13 of Real World Haskell.

  6. Maybe it would be nice to provide an instance for complete numeric typeclasses, like Fractional a.

  7. Data.Text is not yet part of the Haskell Platform, but can easily be installed from hackage.

  8. In order to define an instance for String, which is itself a type synonym for [Char], we have to switch on the TypeSynonymInstances extension of GHC.

  9. All source is licensed under the Apache License, Version 2.0.

  10. (Warning: Sloppy mathematics!) In a sense the mapping of every argument to its result for a pure function can be expressed in tuples. Therefore this similarity of tuples and pure functions is not that much of a surprise.

Wednesday 3 February 2010

Curry’n’C Converter — Using Haskell with Objective-C in the Classic Cocoa Tutorial


Using the classic “Currency Converter” Objective-C tutorial application as an example I show how to implement the model layer of a Cocoa application in Haskell:

  • I explain how to modify the standard Xcode project for building a mixed Haskell/Objective-C application.

  • I create an Objective-C wrapper class for the Haskell model part that hides the Haskell implementation from the Objective-C controller layer. Objects of this wrapper class are pure Objective-C objects and can utilize the Objective-C garbage collector for triggering the freeing of used Haskell data.

  • The result is a fully native OS X application.

Introduction

The native way to write an application for Mac OS X is by using Cocoa, which is an Objective-C framework. Therefore programming in Objective-C offers the full potential of Cocoa and helps to create user-friendly applications for the Mac. But as much as Objective-C is preferable for implementing the interaction with the user or the communication with the OS X system, in modeling specific problems other programming languages might be better suited.

Haskell is functional programming language that is particularly good in dealing with abstract data. It has a very concise syntax and its type system offers great help to the developer for precisely describing difficult problems. And as Haskell is a compiled language you do not have to trade in speed for expressiveness. This makes Haskell an excellent implementation language for the model layer of an application.

Preparation

This posting assumes that you have a basic knowledge of Objective-C and Cocoa. Ideally, you already have worked your way through the original “Currency Converter” tutorial before.

There are many good resources for learning Haskell, but as one does not want to read all the books, I would recommend “Real World Haskell”. If you just want a short introduction to Haskell take a look at alpheccar’s “Haskell Study Plan”.

Used software:

  • Mac OS X “Snow Leopard”, Version 10.6.2.

  • Xcode, Version 3.2.1.

  • The Haskell Platform, Version 2009.2.0.2.1

  • Python. The pre-installed version on Snow Leopard is fine.

We start with the up and running full Objective-C version of the “Currency Converter” application. It is used by Apple as an example of the Model-View-Controller (MVC) design pattern2. In the course of the current tutorial we will step-by-step replace the Objective-C version of the model-layer by a Haskell implementation.

Using Haskell with Objective-C

There is currently no direct support of bridging Haskell and Objective-C via Haskell’s Foreign Function Interface (FFI),3 so we will use C as a mediating layer.

There are basically two ways of using Haskell and Objective-C in the same application:

  1. Use Objective-C as the “main language” and initializing Haskell from the Objective-C application. Here the Haskell part is basically provided as a library that will be called from C.

  2. Call the Objective-C runtime from an outer Haskell layer.

The first approach is made complicated as currently GHC cannot create stand-alone libraries for use with Objective-C. 4 One way the get around this limitation is to directly patch the GHC to create fully linked libs, as done in the GHC-iPhone project. Another approach is to compile the Haskell part to an object file (.o-file) and then include this into the Xcode project. As the .o-file has not the necessary Haskell libraries linked, this has to be done by hand in Xcode. A nice tutorial that shows this, can be found on the Haskel Wiki.

For this tutorial I choose to use Haskell as the main language and to call the Objective-C runtime from inside the Haskell main function. This is actually quite easy using the Foreign Function Interface (FFI):

When we take a look at the standard main.m of a Cocoa project

#import <Cocoa/Cocoa.h>

int main(int argc, char *argv[])
{
    return NSApplicationMain(argc,  (const char **) argv);
}

we see, that all we have to do is to call the NSApplicationMain function from Haskell to start a Cocoa application. The documentation states that

Return Value
This method never returns a result code. Instead, it calls the exit function to exit the application and terminate the process. If you want to determine why the application exited, you should look at the result code from the exit function instead.

Furthermore the arguments to NSApplicationMain will be ignored.

An example Haskell implementation of main.m would therefore look like that:

{-# LANGUAGE ForeignFunctionInterface #-}

import Foreign
import Foreign.C.Types

foreign import ccall "Cocoa.h NSApplicationMain" 
    c_NSApplicationMain :: CInt -> Ptr (Ptr CChar) -> IO CInt

main = c_NSApplicationMain 0 nullPtr

The first lines just tell the GHC that we want to use the FFI and import the necessary modules. The line starting with foreign import makes the NSApplicationMain function available for usage in Haskell. It gives it a new name c_NSApplicationMain and defines its argument and return types. Having done that, we are ready to use this function as the only action in the main function. Please note that we are passing 0 arguments and the nullPtr which is basically the NULL pointer in C.

We will now take this template and add the model functionality for inclusion in the Currency Converter application.

Curry’n’C Converter: A first try

In order to plug-in a Haskell model we will start with modifying the ConverterController.m like this:

extern double convert(double amount, double rate);

@implementation ConverterController

- (IBAction)convert:(id)sender {
    double sourceAmount = [dollarField doubleValue];
    double rate = [rateField doubleValue];

    double targetAmount = convert(sourceAmount, rate);

    [amountField setDoubleValue:targetAmount]; 
    [rateField selectText:self]; 
}

@end

The generation of a model object has been completely dropped from the controller and we now call a C-function in order to do the currency conversion. This function is declared as extern and it will finally be provided by Haskell, but for now — in order to make the project compile again — we will use a dummy implementation of this function in C.

For this we will rename main.m to haskell_dummy_interface.m and include a dummy implementation of the convert function:

#import <Cocoa/Cocoa.h>

double convert(double amount, double rate)
{
    return -42.0;
}

int main(int argc, char *argv[])
{
    return NSApplicationMain(argc,  (const char **) argv);
}

We still have the main function in there as well as the new convert function. All these functions are just provided to make Xcode compile the project as before. In a second step these implementations will be replaced by the Haskell versions. The dummy implementation of convert just gives back a nonsense value no matter what values you want to convert. Build & run the application with Xcode as a test: the build process should work without warnings or errors just as before.

Now it’s time to replace the dummy C functions with the real Haskell implementations! Create a new file in Xcode called “Converter.hs” with the following content:

{-# LANGUAGE ForeignFunctionInterface #-}
import Foreign
import Foreign.C.Types

foreign import ccall "Cocoa.h NSApplicationMain" 
    c_NSApplicationMain :: CInt -> Ptr (Ptr CChar) -> IO CInt
foreign export ccall convert :: CDouble -> CDouble -> CDouble

convert :: CDouble -> CDouble -> CDouble
convert amount rate = amount * rate

main = c_NSApplicationMain 0 nullPtr

This file is just the previously discussed main Haskell implementation plus the definition of the convert function that will be called by the C code: The convert function just takes two CDouble arguments, multiplies them, and returns the result again as a CDouble. This definition is made public for C via the foreign export line. The type CDouble is translated to a plain double value in C by the FFI (this type — and others — is provided by the Foreign.C.Types module, as you might have guessed).

After getting all the source files right we now have to build the application. For this we proceed in the following way:

  1. Do a plain vanilla build of the pure Xcode project for the *.m files. Using our haskell_dummy_interface.m file as a placeholder for the Haskell part. This is done via the normal Xcode build mechanism.

  2. Remove the haskell_dummy_interface.o object file from the build directory as it will be replaced by a Haskell version.

  3. Compile the Haskell file Converter.hs with GHC. We will pass the necessary frameworks to GHC via its -framework flag. Also, if we later want to call functions defined in the C part of the project we want to pass all necessary *.o object files to the GHC linker. It’s ok to just pass all *.o files (apart from the haskell_dummy_interface.o) to the GHC. The linker will take what it needs and just leave the rest.

  4. Finally copy the finished Haskell executable to the application’s MacOS folder and give it the right name.

The result will be a complete Mac OS X application.5

In order to automate this process I have written a short python script. This script can now be called during the Xcode build as the last step of the build phase: Just choose the target in Xcode and add a new build phase via Project > New Build Phase > New Run Script Build Phase. This will create a new subfolder in the target build phase “Run Script” folder under the main target. Double-click this folder which will bring up an info box where you can paste the the python script. Just set the shell to /usr/bin/python and the script will be called as the last step of the build process.

For your convenience I have provided this example Xcode project as a download.

A somewhat more complete converter

But this first try is some kind of cheating. We are just replacing a very simple C function with an extremely simple Haskell function. Most of the time the simplest solution is the best, but as the Currency Converter should be an example for more interesting problems — where the job of the model would involve more than just multiplying two numbers — it would be better to build a “real” Haskell model implementation.

For a model we would like to be able to create data structures and then use functions on these data structures or, with the Currency Converter as an example, we would like to

  1. Create Converter “entities” (whatever this means).

  2. Use these entities to convert dollar origAmount into another currency using an exchange rate.

This Converter model can easily be defined in Haskell:

data Converter = Converter {
      origAmount :: Double,
      rate       :: Double
    }

convert :: Converter -> Double
convert (Converter amount xrate) = amount * xrate

But this is just the Haskell part. In order to use the Converter implementation from C we will need at least three functions: one function two create a Converter entity and to pass some kind of reference for this entity to C, another function to call convert on this entity using the reference, and a last function to dispose of the created entity again.

As the create and convert steps will be separated in the final C code we will have to tell the Haskell implementation to “store” the Converter entity after creation for a later use. This is exactly the use case for the Stable Pointer of the FFI: StablePtr.

To quote the documentation:

A stable pointer is a reference to a Haskell expression that is guaranteed not to be affected by garbage collection, i.e., it will neither be deallocated nor will the value of the stable pointer itself change during garbage collection (ordinary references may be relocated during garbage collection). Consequently, stable pointers can be passed to foreign code, which can treat it as an opaque reference to a Haskell value.

Perfect!

With the provided functions of the Foreign.StablePtr module we can now implement the C interface:

foreign export ccall 
    c_newConverter :: CDouble -> CDouble -> IO (StablePtr Converter)
foreign export ccall 
    c_freeConverter :: StablePtr Converter -> IO ()
foreign export ccall 
    c_convert :: StablePtr Converter -> IO (CDouble)

c_newConverter :: CDouble -> CDouble -> IO (StablePtr Converter)
c_newConverter amount rate = newStablePtr $ 
                             Converter (realToFrac amount) (realToFrac rate)

c_freeConverter :: StablePtr Converter -> IO ()
c_freeConverter = freeStablePtr

c_convert :: StablePtr Converter -> IO (CDouble)
c_convert = (liftM (realToFrac . convert) ) . deRefStablePtr

The type StablePtr Converter is seen in C as an opaque pointer of type void*. It is best to define a new C type HsStablePtr like typedef void *HsStablePtr, that will represent this opaque Haskell reference in the C code. This can be done in a header file FFI.h as described here.

The resulting C types for the Converter API are then

extern HsStablePtr c_newConverter(double amount, double rate);
extern void c_freeConverter(HsStablePtr converter);
extern double c_convert(HsStablePtr converter);

This can now be called from the ConverterController.m directly like this:

- (IBAction)convert:(id)sender {
    double sourceAmount = [dollarField doubleValue];
    double rate = [rateField doubleValue];

    HsStablePtr converter = c_newConverter(sourceAmount, rate);
    double targetAmount = c_convert(converter);

    [amountField setDoubleValue:targetAmount]; 
    [rateField selectText:self]; 

    c_freeConverter(converter);
}

And we have some kind of Haskell implementation of the model.

But it’s not really that beautiful: First of all the controller has to deal directly with the Haskell values and secondly we have to free the Haskell entity manually inside the controller. It would be nice if all this Haskell handling can be abstracted away and the memory management should really be business of the Objective-C garbage collector.

The final implementation

In order to hide the actual Haskell implementation from the controller, we will create a new wrapper model class, called HSConverter. It provides two methods for the controller:

-(id)initWithAmount:(double)amount rate:(double)rate;
-(double)convert;

and the Haskell HsStablePtr reference is stored as a data member of the object and will be freed by c_freeConverter() during the garbage collection in Objective-C. 6

With this we can now define the implementation of HSConverter.m:

extern HsStablePtr c_newConverter(double amount, double rate);
extern void c_freeConverter(HsStablePtr converter);
extern double c_convert(HsStablePtr converter);

@interface HSConverter : NSObject {
    HsStablePtr converter;
}

@implementation HSConverter
-(id)initWithAmount:(double)amount rate:(double)rate;
{
    [super init];
    converter = c_newConverter(amount, rate);
    return self;
}

- (void)finalize;       // this will be called by the GC
{
    c_freeConverter(converter);
    [super finalize];
}

-(id)init;
{
    // hardened, in case someone uses the standard init method
    return [self initWithAmount:1.0 rate:-1.0];
}

-(double)convert;
{
    return c_convert(converter);    
}
@end

And accordingly the final version of the ConverterController.m:

#import "ConverterController.h"
#import "HSConverter.h"

@implementation ConverterController
- (IBAction)convert:(id)sender {
    double sourceAmount = [dollarField doubleValue];
    double rate = [rateField doubleValue];

    HSConverter *converter = [[HSConverter alloc] 
                                initWithAmount:sourceAmount rate:rate];
    double targetAmount = [converter convert];

    [amountField setDoubleValue:targetAmount]; 
    [rateField selectText:self]; 
}
@end

This controller now does not know that it is dealing with a Haskell implementation of the converter and has not to deal with manual memory management any more. In fact it looks more or less like the original implementation of the controller in the all Objective-C version. These HSConverter objects are plain Objective-C objects and can be passed to other methods or stored in NSArrays, for example.

And here is the final Xcode project as a download.

Conclusion

This posting mainly reflects my own learning experience. I hope that it will help others in building Haskell/Objective-C applications. It surely is just a starting point.

The way I am using a dummy C interface just to make Xcode compile the project and then throw away the dummy object file and use GHC to create the ‘real’ object can really only be called ‘work-around’, if not ‘hack’. But there is currently no clean way to compile mixed Haskell / Objective-C applications. The other approach also has to deal with this problem in its own way. Once the GHC is able to build complete (static) libs for the Mac it will be much simpler to create Cocoa applications with Haskell.

The Currency Converter really is a too trivial problem and it seems like overkill to use Haskell and the whole bridging infrastructure for such a simple task. But it stands just as an example for how it might be possible to implement a model in Haskell for a more interesting MVC application.




  1. You will need to patch the GHC Haskell compiler to build 32-bit code in Snow Leopard. Please see this posting by Alvaro Videla. A 64-bit GHC is as-of-today not yet ready for Snow Leopard.

  2. The MVC design pattern is explained in the linked Apple tutorial.

  3. There is some research going on to extend the existing foreign function interface for direct Haskell/Objective-C support.

  4. There seems to be some support for windows DLLs, though. Also, the next version of GHC is supposed to have support for dynamic libraries for the Mac.

  5. It will just be the 32-bit i686 version of the application as GHC will not create the PowerPC binary or the 64-bit version.

  6. Please remember to switch on garbage collection support in the Xcode project!