HasFFIType demo

ffitypedemo/cabal.project

@@ -0,0 +1 @@
+packages: .

ffitypedemo/cbits/exporttest.c

@@ -0,0 +1,11 @@
+#include "exporttest.h"
+
+#include <stdio.h>
+
+void foo(int i) {
+    printf("foo: %d\n", i);
+}
+
+void bar(struct SomeStruct *s) {
+    printf("bar: %d %d\n", s->i, s->j);
+}

ffitypedemo/cbits/exporttest.h

@@ -0,0 +1,9 @@
+#pragma once
+
+struct SomeStruct {
+  int i;
+  int j;
+};
+
+void foo(int i);
+void bar(struct SomeStruct *s);

ffitypedemo/ffitypedemo.cabal

@@ -0,0 +1,35 @@
+cabal-version: 3.0
+name:          ffitypedemo
+version:       0.1.0
+license:       BSD-3-Clause
+author:        Edsko de Vries
+maintainer:    [email protected]
+build-type:    Simple
+
+common lang
+  default-language:   GHC2021
+  build-depends:      base >= 4.16 && < 5
+  ghc-options:        -Wall
+
+  default-extensions:
+      CApiFFI
+      DefaultSignatures
+      DerivingStrategies
+      TypeFamilies
+
+executable ffitypedemo
+  import:         lang
+  hs-source-dirs: src
+  main-is:        Main.hs
+
+  other-modules:
+      A
+      B
+      C
+      SomeOtherModule
+      SomeStruct
+      Runtime
+
+  include-dirs: cbits
+  c-sources:    cbits/exporttest.c
+  cc-options:   -Wall

ffitypedemo/src/A.hs

@@ -0,0 +1,13 @@
+module A where
+
+import Foreign
+import Runtime
+
+newtype A = A { unA :: Int }
+  deriving stock (Show)
+  deriving newtype (Num, Storable)
+
+instance HasFFIType A where
+  type FFIType A = Int
+  coerceFFI = coerceFFI . unA
+

ffitypedemo/src/B.hs

@@ -0,0 +1,13 @@
+module B where
+
+import Foreign
+import Runtime
+import A
+
+newtype B = B { unB :: A }
+  deriving stock (Show)
+  deriving newtype (Num, Storable)
+
+instance HasFFIType B where
+  type FFIType B = Int
+  coerceFFI = coerceFFI . unB

ffitypedemo/src/C.hs

@@ -0,0 +1,13 @@
+module C where
+
+import B
+import Foreign
+import Runtime
+
+newtype C = C { unC :: B }
+  deriving stock (Show)
+  deriving newtype (Num, Storable)
+
+instance HasFFIType C where
+  type FFIType C = Int
+  coerceFFI = coerceFFI . unC

ffitypedemo/src/Main.hs

@@ -0,0 +1,10 @@
+module Main (main) where
+
+import SomeOtherModule
+import SomeStruct
+import Foreign
+
+main :: IO ()
+main = do
+    foo 1234
+    with (SomeStruct 12 34) bar

ffitypedemo/src/Runtime.hs

@@ -0,0 +1,19 @@
+module Runtime where
+
+import Data.Kind
+import Foreign
+
+class HasFFIType a where
+  type FFIType a :: Type
+  type FFIType a = a
+
+  coerceFFI :: a -> FFIType a
+
+  default coerceFFI :: (a ~ FFIType a) => a -> FFIType a
+  coerceFFI = id
+
+instance HasFFIType Int
+-- other instances for marshallable types
+
+instance HasFFIType (Ptr a)
+

ffitypedemo/src/SomeOtherModule.hs

@@ -0,0 +1,12 @@
+module SomeOtherModule where
+
+import Runtime
+import C
+
+foreign import capi "exporttest.h foo"
+  foo_hash1234 :: Int -> IO ()
+
+foo :: C -> IO ()
+foo c = foo_hash1234 (coerceFFI c)
+
+

ffitypedemo/src/SomeStruct.hsc

@@ -0,0 +1,27 @@
+module SomeStruct where
+
+import Foreign
+import C
+
+#include "exporttest.h"
+
+data SomeStruct = SomeStruct {
+      i :: C
+    , j :: C
+    }
+
+instance Storable SomeStruct where
+  sizeOf    _ = #size      struct SomeStruct
+  alignment _ = #alignment struct SomeStruct
+
+  peek p = do
+      i <- (#peek struct SomeStruct, i) p
+      j <- (#peek struct SomeStruct, j) p
+      return SomeStruct{i, j}
+
+  poke p SomeStruct{i, j} = do
+      (#poke struct SomeStruct, i) p i
+      (#poke struct SomeStruct, j) p j
+
+foreign import capi "exporttest.h bar"
+  bar :: Ptr SomeStruct -> IO ()