Add inline-c example

This commit adds a worked example of `inline-c`.
It is quite close to hand-written bindings, but it is syntactically
convenient.

Fixes #38

alternatives/README.md

@@ -126,6 +126,65 @@ at times, especially with cross compilation.
 
 See https://github.com/haskell/c2hs/wiki/User-Guide for more information.
 
+## `inline-c`
+
+The [`inline-c` library](https://hackage.haskell.org/package/inline-c) can be
+used to manually write bindings to a C library. This is mostly a syntactic
+convenience; under the hood, the library uses Template Haskell to generate
+foreign import declarations.
+
+For example, code of the form
+
+```hs
+import qualified Language.C.Inline as C
+import MyLibContext( myLibCtxt )
+
+C.include "myLib.h"
+C.context myLibCtxt
+
+myFunction :: CInt -> HsEnum -> IO HsStruct
+myFunction i f =
+   [|C.exp| CStruct* { myCFunction($(int i), $(CEnum f)) } |]
+```
+
+will generate a foreign import
+
+```hs
+foreign import safe <inline_c_internal_id_1>
+  inline_c_internal_id_1 :: CInt -> CEnum -> IO (Ptr CStruct)
+```
+
+as well as a `.c` file of the form
+
+```c
+#include "myLib.h"
+
+CStruct* inline_c_internal_id_1 (int i, CEnum s) {
+  myCFunction(i, s);
+}
+```
+
+Here `myLibCtxt` specifies how Haskell and C types are interconverted:
+
+```hs
+module MyLibContext where
+
+import qualified Language.C.Inline as C
+
+data HsEnum = ...
+instance Storable HsEnum
+data HsStruct = ...
+instance Storable HsStruct
+
+myLibCtxt :: C.Context
+myLibCtxt = mempty
+  { C.ctxtTypesTables = Map.fromList
+    [ ( C.TypeName "CEnum"  , [t| HsEnum |] )
+    , ( C.TypeName "CStruct", [t| HsStruct |] )
+    ]
+  }
+```
+
 ## `cgen`
 
 TODO <https://github.com/well-typed/hs-bindgen/issues/6>

alternatives/cabal.project

@@ -1,5 +1,6 @@
-packages: 
+packages:
   experiment/manual
+  experiment/inline-c
   experiment/hsc2hs
   experiment/c2hs
   tools/hsc2hs

alternatives/experiment/inline-c/LICENSE

@@ -0,0 +1,29 @@
+Copyright (c) 2024, Well-Typed LLP and Anduril Industries Inc. 
+
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of the copyright holder nor the names of its
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

alternatives/experiment/inline-c/app/HsBindgenCExample.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+-- | Handwritten bindings, using inline-c.
+module HsBindgenCExample where
+
+-- base
+import Foreign
+import Foreign.C.Types
+
+-- inline-c
+import qualified Language.C.Inline as C
+
+-- try-inline-c
+import Types
+
+--------------------------------------------------------------------------------
+
+C.context (C.baseCtx <> C.funCtx <> exampleContext)
+C.include "hs-bindgen-c-example.h"
+
+{-------------------------------------------------------------------------------
+  Valid declarations
+-------------------------------------------------------------------------------}
+
+cHelloWorld :: IO ()
+cHelloWorld = [C.exp| void { hs_bindgen_c_example_helloworld(); } |]
+
+cShowInt :: CInt -> IO ()
+cShowInt i =
+  [C.exp| void { hs_bindgen_c_example_showInt($(int i)); } |]
+
+cShowStruct :: Ptr HaskellStruct -> IO ()
+cShowStruct str =
+  [C.exp| void { hs_bindgen_c_example_showStruct($(ExampleStruct* str)); }|]
+
+cCallFunPtr :: FunPtr_Void_Int -> IO ()
+cCallFunPtr ptr =
+  [C.exp| void { hs_bindgen_c_example_callFunPtr($(FunPtr_Void_Int ptr)); } |]
+
+addrOf_cShowInt :: IO FunPtr_Void_Int
+addrOf_cShowInt =
+  [C.exp| FunPtr_Void_Int { &hs_bindgen_c_example_showInt } |]
+
+cReturnFunPtr :: IO FunPtr_Void_Int
+cReturnFunPtr =
+  [C.exp| FunPtr_Void_Int { hs_bindgen_c_example_returnFunPtr() } |]
+
+callFunPtr_Void_Int :: FunPtr_Void_Int -> CInt -> IO ()
+callFunPtr_Void_Int ptr i =
+  [C.exp| void { $(FunPtr_Void_Int ptr)($(int i)) } |]
+
+wrapFunPtr_Void_Int :: (CInt -> IO ()) -> IO FunPtr_Void_Int
+wrapFunPtr_Void_Int f =
+  [C.exp| void (*)(int) { $fun:(void (*f)(int)) } |]
+
+{-------------------------------------------------------------------------------
+  Invalid declarations
+-------------------------------------------------------------------------------}
+
+#ifdef INCLUDE_INVALID
+
+invalid_cShowInt_wrongParam :: Ptr CInt -> IO ()
+invalid_cShowInt_wrongParam i
+  = [C.exp| void { hs_bindgen_c_example_showInt($(int i)) } |]
+
+#endif

alternatives/experiment/inline-c/app/Main.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE CPP #-}
+
+module Main (main) where
+
+-- base
+import Foreign
+import System.IO
+
+-- try-inline-c
+import Types
+import HsBindgenCExample
+
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+    hSetBuffering stdout NoBuffering
+
+    -- Simplest example: call C function with no arguments, no result
+    cHelloWorld
+
+    -- C function with a single argument
+    cShowInt 1234
+
+    -- C function taking a pointer to a struct as argument
+    alloca $ \ptr -> do
+      poke ptr $ HaskellStruct 1234 5678
+      cShowStruct ptr
+
+    -- C function taking a pointer to a function, passing another C function
+    addr <- addrOf_cShowInt
+    cCallFunPtr addr
+
+    -- C function returning a pointer to a function, executing it in Haskell
+    funPtrFromC <- cReturnFunPtr
+    callFunPtr_Void_Int funPtrFromC 12345678
+
+    -- C function taking a pointer to a function, passing a Haskell function
+    funPtrFromHaskell <- wrapFunPtr_Void_Int $ \x ->
+      putStrLn $ "fromHaskell: " ++ show x
+    cCallFunPtr funPtrFromHaskell
+
+#ifdef INCLUDE_INVALID
+    alloca $ \ptr ->
+      invalid_cShowInt_wrongParam ptr
+#endif

alternatives/experiment/inline-c/app/Types.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskellQuotes #-}
+
+module Types where
+
+-- base
+import Foreign
+import Foreign.C.Types
+
+-- containers
+import qualified Data.Map as Map
+
+-- inline-c
+import qualified Language.C.Inline.Context as C
+import qualified Language.C.Types as C
+
+{-------------------------------------------------------------------------------
+  Context
+-------------------------------------------------------------------------------}
+
+type FunPtr_Void_Int = FunPtr (CInt -> IO ())
+
+data HaskellStruct = HaskellStruct {
+      haskellStructA :: CInt
+    , haskellStructB :: CInt
+    }
+
+instance Storable HaskellStruct where
+  sizeOf    _ = 8
+  alignment _ = 4
+
+  peek s = do
+      haskellStructA <- peekByteOff s 0
+      haskellStructB <- peekByteOff s 4
+      return HaskellStruct{haskellStructA, haskellStructB}
+
+  poke s HaskellStruct{haskellStructA, haskellStructB} = do
+      pokeByteOff s 0 haskellStructA
+      pokeByteOff s 4 haskellStructB
+
+exampleContext :: C.Context
+exampleContext = mempty
+  { C.ctxTypesTable = Map.fromList
+    [ ( C.TypeName "ExampleStruct"  , [t| HaskellStruct |] )
+    , ( C.TypeName "FunPtr_Void_Int", [t| FunPtr_Void_Int |] )
+    ]
+  }

alternatives/experiment/inline-c/try-inline-c.cabal

@@ -0,0 +1,41 @@
+cabal-version:      3.0
+name:               try-inline-c
+version:            0.1.0
+license:            BSD-3-Clause
+license-file:       LICENSE
+author:             Edsko de Vries
+maintainer:         [email protected]
+build-type:         Simple
+
+common lang
+  ghc-options:
+      -Wall
+  build-depends:
+      base >= 4.16
+    , containers >= 0.5 && < 0.8
+  default-language:
+     GHC2021
+
+executable try-inline-c
+  import:
+     lang
+  hs-source-dirs:
+      app
+  main-is:
+      Main.hs
+  other-modules:
+      HsBindgenCExample
+      Types
+  build-depends:
+      inline-c ^>= 0.9
+  --pkgconfig-depends:
+  --    hs-bindgen-c-example
+
+  if(flag(include-invalid))
+    cpp-options:
+      -DINCLUDE_INVALID
+
+flag include-invalid
+  description: Also include invalid declarations
+  default: False
+  manual: True