├── Library.hs
├── MainIntf.hsc
├── Setup.hs
├── Stub.hs
├── haskell-to-c.cabal
├── main.c
├── main.cpp
├── main.h
└── package.yaml


/Library.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE ForeignFunctionInterface #-}
 2 | 
 3 | module Library where
 4 | 
 5 | import           Data.Foldable
 6 | import qualified Data.Vector.Storable as SV
 7 | import           Foreign.C.String
 8 | import           Foreign.C.Types
 9 | import           Foreign.Ptr
10 | import           Foreign.ForeignPtr
11 | import           Foreign.StablePtr
12 | import           Foreign.Storable
13 | import           MainIntf
14 | import           System.IO.Unsafe
15 | 
16 | foreign export ccall c_initState :: CInt -> IO (Ptr ())
17 | foreign export ccall c_freeState :: Ptr () -> IO ()
18 | foreign export ccall c_processTrack :: Ptr C'Track -> Ptr () -> Ptr (Ptr ()) -> IO CString
19 | foreign export ccall c_sampleMethod :: CInt -> Ptr () -> Ptr (Ptr ()) -> CString
20 | 
21 | c_initState :: CInt -> IO (Ptr ())
22 | c_initState n = castStablePtrToPtr <$> newStablePtr n
23 | 
24 | c_processTrack :: Ptr C'Track -> Ptr () -> Ptr (Ptr ()) -> IO CString
25 | c_processTrack trackPtr st res = do
26 |     let v = castPtrToStablePtr st :: StablePtr Int
27 |     st' <- deRefStablePtr v
28 |     track <- peek trackPtr
29 |     fpoints <- newForeignPtr_ (c'Track'points track)
30 |     let vec = SV.unsafeFromForeignPtr0 fpoints 1
31 |     let (str', st'''') = (\f -> foldl' f ("", st') (SV.toList vec)) $ \(acc, st'') n ->
32 |             let (str', st''') = processTrack (fromIntegral (c'Point'moment n)) st'' in
33 |             (acc ++ str', st''')
34 |     str'' <- newCString str'
35 |     freeStablePtr v
36 |     v' <- newStablePtr st''''
37 |     poke res (castStablePtrToPtr v')
38 |     return str''
39 | 
40 | c_freeState :: Ptr () -> IO ()
41 | c_freeState st = freeStablePtr (castPtrToStablePtr st)
42 | 
43 | processTrack :: Int -> Int -> (String, Int)
44 | processTrack x y = (show x ++ ":" ++ show y, y + 1)
45 | 
46 | c_sampleMethod :: CInt -> Ptr () -> Ptr (Ptr ()) -> CString
47 | c_sampleMethod n st res = unsafePerformIO $ do
48 |     let v = castPtrToStablePtr st :: StablePtr Int
49 |     st' <- deRefStablePtr v
50 |     let (str, n') = sampleMethod (fromIntegral n) st'
51 |     str' <- newCString str
52 |     freeStablePtr v
53 |     v' <- newStablePtr n'
54 |     poke res (castStablePtrToPtr v')
55 |     return str'
56 | 
57 | sampleMethod :: Int -> Int -> (String, Int)
58 | sampleMethod x y = (show x ++ ":" ++ show y, y + 1)
59 | 


--------------------------------------------------------------------------------
/MainIntf.hsc:
--------------------------------------------------------------------------------
 1 | {-# OPTIONS_GHC -fno-warn-unused-imports #-}
 2 | 
 3 | #include <bindings.dsl.h>
 4 | #include "main.h"
 5 | 
 6 | module MainIntf where
 7 | 
 8 | import Foreign.Ptr
 9 | import qualified Data.Vector.Storable as SV
10 | 
11 | #strict_import
12 | 
13 | #starttype struct Point
14 | #field moment , CLong
15 | #field latitude , CDouble
16 | #field longitude , CDouble
17 | #stoptype
18 | 
19 | #starttype struct Track
20 | #field points , Ptr <Point>
21 | #stoptype
22 | 


--------------------------------------------------------------------------------
/Setup.hs:
--------------------------------------------------------------------------------
1 | import Distribution.Simple
2 | main = defaultMain
3 | 


--------------------------------------------------------------------------------
/Stub.hs:
--------------------------------------------------------------------------------
1 | module Stub where
2 | 


--------------------------------------------------------------------------------
/haskell-to-c.cabal:
--------------------------------------------------------------------------------
 1 | -- This file has been generated from package.yaml by hpack version 0.18.0.
 2 | --
 3 | -- see: https://github.com/sol/hpack
 4 | 
 5 | name:           haskell-to-c
 6 | version:        0.0.1
 7 | synopsis:       Example of producing a C library from Haskell code
 8 | category:       System
 9 | homepage:       https://github.com/jwiegley/haskell-to-c#readme
10 | bug-reports:    https://github.com/jwiegley/haskell-to-c/issues
11 | author:         John Wiegley
12 | maintainer:     johnw@newartisans.com
13 | license:        MIT
14 | build-type:     Simple
15 | cabal-version:  >= 1.10
16 | 
17 | source-repository head
18 |   type: git
19 |   location: https://github.com/jwiegley/haskell-to-c
20 | 
21 | library
22 |   include-dirs:
23 |       ./.
24 |   build-depends:
25 |       base     >= 4.9   && < 5
26 |     , vector
27 |     , bindings-DSL
28 |   exposed-modules:
29 |       Library
30 |       MainIntf
31 |   other-modules:
32 |       Paths_haskell_to_c
33 |   default-language: Haskell2010
34 | 
35 | executable c-driver
36 |   main-is: main.c
37 |   ghc-options: -no-hs-main
38 |   build-depends:
39 |       base     >= 4.9   && < 5
40 |     , vector
41 |     , bindings-DSL
42 |     , haskell-to-c
43 |   other-modules:
44 |       Stub
45 |   default-language: Haskell2010
46 | 
47 | executable cpp-driver
48 |   main-is: main.cpp
49 |   ghc-options: -no-hs-main
50 |   extra-libraries:
51 |       c++
52 |   build-depends:
53 |       base     >= 4.9   && < 5
54 |     , vector
55 |     , bindings-DSL
56 |     , haskell-to-c
57 |   other-modules:
58 |       Stub
59 |   default-language: Haskell2010
60 | 


--------------------------------------------------------------------------------
/main.c:
--------------------------------------------------------------------------------
 1 | #include <stdio.h>
 2 | #include "HsFFI.h"
 3 | 
 4 | extern void *c_initState(int);
 5 | extern void  c_freeState(void *);
 6 | extern char *c_sampleMethod(int, void *, void **);
 7 | 
 8 | int main(int argc, char *argv[]) {
 9 |   hs_init(&argc, &argv);
10 | 
11 |   void *state = c_initState(50);
12 | 
13 |   char *result = c_sampleMethod(100, state, &state);
14 |   printf("Result = %s\n", result);
15 | 
16 |   result = c_sampleMethod(200, state, &state);
17 |   printf("Result = %s\n", result);
18 | 
19 |   result = c_sampleMethod(300, state, &state);
20 |   printf("Result = %s\n", result);
21 | 
22 |   c_freeState(state);
23 | 
24 |   hs_exit();
25 | }
26 | 


--------------------------------------------------------------------------------
/main.cpp:
--------------------------------------------------------------------------------
 1 | #include "main.h"
 2 | 
 3 | int main(int argc, char *argv[])
 4 | {
 5 |   hs_init(&argc, &argv);
 6 | 
 7 |   void *state = c_initState(50);
 8 | 
 9 |   for (int i = 0; i < 3; i++)
10 |   {
11 |     Point p1 = { 1, 1.0, 2.0 };
12 |     Point p2 = { 2, 1.0, 2.0 };
13 |     std::vector<Point> v;
14 |     v.push_back(p1);
15 |     v.push_back(p2);
16 |     Track track(v);
17 | 
18 |     char *result = c_processTrack(&track, state, &state);
19 |     printf("Result = %s\n", result);
20 |   }
21 | 
22 |   c_freeState(state);
23 | 
24 |   hs_exit();
25 | }
26 | 


--------------------------------------------------------------------------------
/main.h:
--------------------------------------------------------------------------------
 1 | #include <stdio.h>
 2 | #include <time.h>
 3 | #include "HsFFI.h"
 4 | 
 5 | struct Point
 6 | {
 7 |   time_t moment;
 8 |   double latitude;
 9 |   double longitude;
10 | };
11 | 
12 | #ifdef __cplusplus
13 | #include <vector>
14 | 
15 | class Track
16 | {
17 |   std::vector<Point> points;
18 | 
19 | public:
20 |   Track(const std::vector<Point>& _points) : points(_points) {}
21 | };
22 | #else
23 | struct Track
24 | {
25 |   struct Point *points;
26 | };
27 | #endif
28 | 
29 | #ifdef __cplusplus
30 | extern "C"
31 | #endif
32 | void *c_initState(int);
33 | #ifdef __cplusplus
34 | extern "C"
35 | #endif
36 | void  c_freeState(void *);
37 | #ifdef __cplusplus
38 | extern "C"
39 | #endif
40 | char *c_processTrack(struct Track *, void *, void **);
41 | 


--------------------------------------------------------------------------------
/package.yaml:
--------------------------------------------------------------------------------
 1 | name:       haskell-to-c
 2 | version:    0.0.1
 3 | synopsis:   Example of producing a C library from Haskell code
 4 | github:     jwiegley/haskell-to-c
 5 | author:     John Wiegley
 6 | maintainer: johnw@newartisans.com
 7 | category:   System
 8 | license:    MIT
 9 | 
10 | dependencies:
11 |   - base     >= 4.9   && < 5
12 |   - vector
13 |   - bindings-DSL
14 | 
15 | library:
16 |   exposed-modules:
17 |     - Library
18 |     - MainIntf
19 |   include-dirs:
20 |     - .
21 | 
22 | executables:
23 |   c-driver:
24 |     main: main.c
25 |     other-modules: Stub
26 |     ghc-options: -no-hs-main
27 |     dependencies:
28 |       - haskell-to-c
29 | 
30 |   cpp-driver:
31 |     main: main.cpp
32 |     other-modules: Stub
33 |     ghc-options: -no-hs-main
34 |     extra-libraries:
35 |       - c++
36 |     dependencies:
37 |       - haskell-to-c
38 | 


--------------------------------------------------------------------------------