├── .gitignore ├── Makefile ├── include └── myfile.h ├── haskel_ffi.cabal ├── cbits └── wrapper.c ├── src └── Example.hsc └── README.md /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | cabal-dev 3 | *.o 4 | *.hi 5 | *.chi 6 | *.chs.h 7 | .virthualenv 8 | .DS_Store 9 | wrapper 10 | *out 11 | .\# 12 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | HSC2HS = hsc2hs 2 | GHC = ghc 3 | CABAL = cabal 4 | 5 | .PHONY: dist/build/Example.o 6 | dist/build/Example.o: 7 | $(CABAL) configure && $(CABAL) build 8 | 9 | .PHONY: wrapper 10 | wrapper: cbits/wrapper.c dist/build/Example.o 11 | $(GHC) --make -no-hs-main -optc-O cbits/wrapper.c ./dist/build/Example.hs -I./dist/build/ -I./include -o wrapper 12 | 13 | clean: 14 | rm -fr *.o */*.o dist wrapper *.out *.so 15 | 16 | all: wrapper 17 | ./wrapper 18 | -------------------------------------------------------------------------------- /include/myfile.h: -------------------------------------------------------------------------------- 1 | #ifndef EXAMPLE_H 2 | #define EXAMPLE_H 3 | 4 | #define DATA_MAX_NAME_LEN 64 5 | 6 | struct bar_s 7 | { 8 | char name[DATA_MAX_NAME_LEN]; 9 | int type; 10 | double min; 11 | double max; 12 | }; 13 | 14 | typedef struct bar_s bar_t; 15 | 16 | struct foo_s 17 | { 18 | char name[DATA_MAX_NAME_LEN]; 19 | int bar_num; 20 | bar_t *bar; 21 | }; 22 | typedef struct foo_s foo_t; 23 | 24 | #define UNION_TYPE_STRING 0 25 | #define UNION_TYPE_NUMBER 1 26 | #define UNION_TYPE_BOOLEAN 2 27 | 28 | struct weird_union_s 29 | { 30 | union 31 | { 32 | char *string; 33 | double number; 34 | int boolean; 35 | } value; 36 | int type; 37 | }; 38 | 39 | typedef struct weird_union_s weird_union_t; 40 | 41 | 42 | 43 | #endif /* EXAMPLE_H */ 44 | -------------------------------------------------------------------------------- /haskel_ffi.cabal: -------------------------------------------------------------------------------- 1 | name: haskell-ffi 2 | version: 0.1.0.0 3 | license: MIT 4 | license-file: LICENSE 5 | author: Alex Petrov 6 | maintainer: alexp@coffeenco.de 7 | copyright: Alex Petrov 8 | build-type: Simple 9 | extra-source-files: cbits/wrapper.c 10 | cabal-version: >=1.10 11 | 12 | library 13 | build-depends: base >=4.7 && <4.8 14 | hs-source-dirs: src 15 | default-language: Haskell2010 16 | exposed-modules: Example 17 | other-extensions: CPP 18 | , ForeignFunctionInterface 19 | , EmptyDataDecls 20 | , RecordWildCards 21 | Include-dirs: include 22 | ghc-options: -threaded -fforce-recomp -shared -dynamic -fPIC 23 | 24 | if (arch(i386) || arch(x86_64)) 25 | cpp-options: -DARCH_X86 26 | -------------------------------------------------------------------------------- /cbits/wrapper.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include "myfile.h" 6 | #include "HsFFI.h" 7 | 8 | /* #ifdef __GLASGOW_HASKELL__ */ 9 | #include "Example_stub.h" 10 | /* #endif */ 11 | 12 | 13 | void 14 | example_init (void) 15 | { 16 | hs_init (NULL, NULL); 17 | } 18 | 19 | void 20 | example_exit (void) 21 | { 22 | hs_exit (); 23 | } 24 | 25 | int main( int argc, char *argv[] ) 26 | { 27 | int bar_count = 3; 28 | foo_t *foo; 29 | foo = malloc(sizeof(*foo)); 30 | memset(foo, 0, sizeof(*foo)); 31 | 32 | char foo_name[] = "foo name"; 33 | strncpy(foo->name, foo_name, sizeof(foo_name)); 34 | 35 | foo->bar_num = bar_count; 36 | foo->bar = (bar_t *) malloc (bar_count * sizeof (bar_t)); 37 | 38 | char first_bar_name[] = "first bar name"; 39 | strncpy(foo->bar[0].name, first_bar_name, sizeof(first_bar_name)); 40 | foo->bar[0].type = 1; 41 | foo->bar[0].min = 0.1; 42 | foo->bar[0].max = 100.0; 43 | 44 | char second_bar_name[] = "second bar name"; 45 | strncpy(foo->bar[1].name, second_bar_name, sizeof(second_bar_name)); 46 | foo->bar[1].type = 2; 47 | foo->bar[1].min = 0.2; 48 | foo->bar[1].max = 200.0; 49 | 50 | char third_bar_name[] = "third bar name"; 51 | strncpy(foo->bar[2].name, third_bar_name, sizeof(third_bar_name)); 52 | foo->bar[2].type = 3; 53 | foo->bar[2].min = 0.3; 54 | foo->bar[2].max = 300.0; 55 | 56 | weird_union_t *wstr; 57 | wstr = malloc(sizeof(*wstr)); 58 | memset(wstr, 0, sizeof(*wstr)); 59 | 60 | char *somestr = "ohai string"; 61 | wstr->value.string = somestr; 62 | wstr->type = 0; 63 | 64 | weird_union_t *wdbl; 65 | wdbl = malloc(sizeof(*wdbl)); 66 | memset(wdbl, 0, sizeof(*wdbl)); 67 | 68 | wdbl->value.number = 0.123; 69 | wdbl->type = 1; 70 | 71 | hs_init (&argc, &argv); 72 | entrypoint(foo, wstr, wdbl); 73 | } 74 | -------------------------------------------------------------------------------- /src/Example.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE EmptyDataDecls #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# LANGUAGE FlexibleInstances #-} 6 | {-# LANGUAGE FlexibleContexts #-} 7 | {-# LANGUAGE RecordWildCards #-} 8 | 9 | module Example where 10 | 11 | import Control.Applicative 12 | import Foreign 13 | import Foreign.C.Types 14 | import Foreign.C.String 15 | 16 | #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 17 | #include "myfile.h" 18 | 19 | -- | 20 | -- | FOO 21 | -- | 22 | 23 | data Foo = Foo 24 | { fooName :: !String 25 | , fooBars :: ![Bar] 26 | } deriving(Eq, Show) 27 | 28 | type FooPtr = Ptr Foo 29 | 30 | instance Storable Foo where 31 | alignment _ = #{alignment foo_t} 32 | sizeOf _ = #{size foo_t} 33 | 34 | -- peek :: FooPtr -> IO (Struct Foo) 35 | peek p = do 36 | Foo 37 | `fpStr` #{ptr foo_t, name} p 38 | `apArr` (#{peek foo_t, bar_num} p, 39 | #{peek foo_t, bar} p) 40 | 41 | poke p Foo{..} = do 42 | cFooName <- newCString fooName 43 | fooNameValue <- peekArray (length fooName) cFooName 44 | pokeArray (#{ptr foo_t, name} p) fooNameValue 45 | 46 | let fooBarsCount = length fooBars 47 | #{poke foo_t, bar_num} p fooBarsCount 48 | barArrPtr <- mallocArray fooBarsCount 49 | pokeArray barArrPtr fooBars 50 | 51 | #{poke foo_t, bar} p barArrPtr 52 | -- | 53 | -- | BAR 54 | -- | 55 | 56 | data Bar = Bar 57 | { barName :: !String 58 | , barType :: !Int 59 | , barMin :: !Double 60 | , barMax :: !Double 61 | } deriving (Eq, Show) 62 | 63 | type BarPtr = Ptr Bar 64 | 65 | instance Storable Bar where 66 | alignment _ = #{alignment bar_t} 67 | sizeOf _ = #{size bar_t} 68 | 69 | peek p = do 70 | Bar 71 | `fpStr` #{ptr bar_t, name} p 72 | `apInt` #{peek bar_t, type} p 73 | `apDbl` #{peek bar_t, min} p 74 | `apDbl` #{peek bar_t, max} p 75 | 76 | poke p Bar{..} = do 77 | cBarName <- newCString barName 78 | barNameValue <- peekArray (length barName) cBarName 79 | pokeArray (#{ptr bar_t, name} p) barNameValue 80 | 81 | #{poke bar_t, type} p barType 82 | #{poke bar_t, min} p barMin 83 | #{poke bar_t, max} p barMax 84 | 85 | -- | 86 | -- | WEIRD UNION 87 | -- | 88 | 89 | data WeirdUnion = UString String | 90 | UDouble Double | 91 | UBool Bool 92 | deriving (Eq, Show) 93 | 94 | 95 | instance Storable WeirdUnion where 96 | alignment _ = #{alignment weird_union_t} 97 | sizeOf _ = #{size weird_union_t} 98 | 99 | peek p = do 100 | unionType <- #{peek weird_union_t, type} p 101 | 102 | case (mkInt unionType) of 103 | 0 -> do 104 | unionValue <- #{peek weird_union_t, value} p 105 | UString <$> (peekCString $ #{ptr weird_union_t, value} unionValue) 106 | 107 | 1 -> UDouble <$> (mkDbl <$> #{peek weird_union_t, value} p) 108 | 109 | 2 -> do 110 | a <- mkInt <$> #{peek weird_union_t, value} p 111 | return $ UBool $ case a of 112 | 0 -> False 113 | 1 -> True 114 | 115 | poke p = undefined 116 | 117 | type WeirdUnionPtr = Ptr WeirdUnion 118 | 119 | foreign export ccall entrypoint :: FooPtr -> WeirdUnionPtr -> WeirdUnionPtr -> IO () 120 | entrypoint :: FooPtr -> WeirdUnionPtr -> WeirdUnionPtr -> IO () 121 | entrypoint foo wurst wudbl = do 122 | print "===== Foo Read from Haskell Code ======" 123 | a <- peek foo 124 | print $ a 125 | 126 | print "===== Union Read from Haskell Code ======" 127 | b <- peek wurst 128 | c <- peek wudbl 129 | print $ b 130 | print $ c 131 | 132 | print "===== Changed from Haskell Code ======" 133 | let someFoo = Foo "created foo" [Bar "1 bar name" 100 0.001 1000.0 134 | , Bar "2 bar name" 200 0.002 2000.0 135 | , Bar "3 bar name" 300 0.003 3000.0] 136 | 137 | poke foo someFoo 138 | 139 | a <- peek foo 140 | print $ a 141 | 142 | return () 143 | 144 | 145 | mkInt :: CInt -> Int 146 | mkInt = fromIntegral 147 | 148 | mkDbl :: CDouble -> Double 149 | mkDbl d = realToFrac d 150 | 151 | 152 | infixl 4 `apInt`, `apDbl`, `fpStr`, `apArr` 153 | 154 | fpStr :: (String -> b) -> CString -> IO b 155 | fpStr a b = a <$> (peekCString b) 156 | 157 | peekCArray :: (Storable a) => CInt -> IO (Ptr a) -> IO [a] 158 | peekCArray i ir = ir >>= peekArray (mkInt i) 159 | 160 | apArr :: Storable a => IO ([a] -> b) -> (IO CInt, IO (Ptr a)) -> IO b 161 | apArr f (i, b) = do 162 | i' <- i 163 | r <- peekCArray i' b 164 | f' <- f 165 | return $ f' r 166 | 167 | apInt :: (Applicative f) => f (Int -> b) -> f CInt -> f b 168 | apInt a b = a <*> (mkInt <$> b) 169 | 170 | apDbl :: (Applicative f) => f (Double -> b) -> f CDouble -> f b 171 | apDbl a b = a <*> (mkDbl <$> b) -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Haskell FFI Tutorial 2 | 3 | This is a demo repository to help out with Haskell FFI, namely, with 4 | nested structures. Everything I've found on the subject up till that 5 | point contained only partial information for what I've needed, 6 | so I decided to compose a complete tutorial together. 7 | 8 | # Covered subjects 9 | 10 | You'll learn how to: 11 | 12 | * (expressively) represent C `struct` in Haskell code 13 | * call C code from Haskell 14 | * call Haskell code from C 15 | * operate on nested `struct`s 16 | * operate on `struct` arrays 17 | * decode `unions` 18 | * read and write C fixed-length strings and Pointer-type Strings 19 | * how to import functions from, for example, stdlib 20 | 21 | # Motivation 22 | 23 | There are many C bindings written for different Haskell projects, and 24 | every one seems to have it's own style. Also, because every C program 25 | is written in a very different style (some use fixed-length strings, 26 | some use `*char`, some have nested structs, some do not, some have 27 | `unions`, some do not), it's somewhat difficult to jump in and start 28 | writing your own C bindings in Haskell, even though all the functionality 29 | is available for you to use. 30 | 31 | I've collected all I've learned about writing Haskell bindings into 32 | a single repository, and will document it all part by part to have 33 | more detailed descriptions, explanation and motivation about how 34 | to do things. 35 | 36 | If you're a seasoned Haskell developer, and everything here is obvious 37 | for you, you can go through the concepts introduced here and give 38 | your feedback, since I am by no means an expert in this area, and 39 | may have misunderstood some things. 40 | 41 | ## Calling Haskell from C 42 | 43 | In order to call Haskell from C, you'd have to: 44 | 45 | * create a C wrapper where you initialize Haskell Runtime 46 | * write a callback function in Haskell, that will be called from C 47 | 48 | Let's start with a callback function in Haskell, since it'll be used 49 | within the C code that we'll write later on. Open up a file, call it 50 | `Example.hsc` (hsc extension is used for the files that are interfacing 51 | C, it will be passed through hsc2hs preprocessor that will unwrap all 52 | the macros. We haven't used any for now, but we will later on). 53 | 54 | ```haskell 55 | {-# LANGUAGE CPP #-} 56 | {-# LANGUAGE ForeignFunctionInterface #-} 57 | 58 | module Example where 59 | 60 | foreign export ccall entrypoint :: IO () 61 | 62 | entrypoint :: IO () 63 | entrypoint = do 64 | print "Hello from Haskell" 65 | 66 | return () 67 | ``` 68 | 69 | So far so good. Now, in order to convert `hsc` file to regular `hs` file, 70 | you have to run 71 | 72 | ``` 73 | hsc2hs Example.hsc 74 | ``` 75 | 76 | Preprocessor will create `Example.hs` file that unwraps all the macros. 77 | 78 | In order to get a stub file that contains all the functions exported from 79 | Haskell to C, you have to run 80 | 81 | ``` 82 | ghc Example.hs 83 | ``` 84 | 85 | `Example_stub.h` will contain a valid signature for our `entrypoint` function. 86 | Namely, something like that (with some C boilerplate that's ommited for readability): 87 | 88 | ``` 89 | extern void entrypoint(void); 90 | ``` 91 | 92 | In order to create a C wrapper, just create a `wrapper.c` file: 93 | 94 | ```c 95 | // Include Haskell FFI file, which we will use to initialize a Haskell runtime 96 | #include "HsFFI.h" 97 | 98 | /* #ifdef __GLASGOW_HASKELL__ */ 99 | #include "Example_stub.h" 100 | /* #endif */ 101 | 102 | int main( int argc, char *argv[] ) 103 | { 104 | // Initialize Haskell Runtime _before_ any calls to the Haskell code 105 | hs_init (&argc, &argv); 106 | 107 | // Make a call to Haskell code 108 | entrypoint(); 109 | } 110 | ``` 111 | 112 | Great, now you can actually compile the `wrapper.c` and run the resulting 113 | binary 114 | 115 | ``` 116 | ghc -no-hs-main wrapper.c Example.hs -o wrapper 117 | ``` 118 | 119 | You'll get a `wrapper` binary, that you can run and see the result: 120 | 121 | ``` 122 | ➜ haskell-ffi-tutorial ./wrapper 123 | "Hello from Haskell" 124 | ``` 125 | 126 | Perfect, now you know how to call Haskell code from C. 127 | 128 | # License 129 | 130 | Copyright (c) 2014 Alex Petrov 131 | 132 | Licensed under MIT License 133 | 134 | Permission is hereby granted, free of charge, to any person obtaining a copy 135 | of this software and associated documentation files (the "Software"), to deal 136 | in the Software without restriction, including without limitation the rights 137 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 138 | copies of the Software, and to permit persons to whom the Software is 139 | furnished to do so, subject to the following conditions: 140 | 141 | The above copyright notice and this permission notice shall be included in 142 | all copies or substantial portions of the Software. 143 | 144 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 145 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 146 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 147 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 148 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 149 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN 150 | THE SOFTWARE. 151 | --------------------------------------------------------------------------------