patrickaldis/garnet
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Expose explicit C interface

Browse Source 
We drop the tools specifically designed for Haskell and Rust together, in favour of general tools for using each with C.

Namely, we use Mozilla's `cbindgen` for generating header files from the Rust source, and Well-Typed's new `hs-bindgen` tool for generating Haskell from those header files.

The Rust code here is essentially the result of expanding the old macro, then inlining and renaming internals.

The most important thing here is that we're now relying solely on robust well-maintained tools.
This commit is contained in:
George Thomas 2026-02-19 11:08:20 +00:00
parent 60f5f23b2d
commit 0a1911862f
13 changed files with 804 additions and 241 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
cabal.project
View File

@ -1,5 +1,28 @@
packages: haskell packages: haskell
-- TODO a total hack
package garnet
extra-lib-dirs:
/home/gthomas/code/garnet/rust/target/release
/home/gthomas/code/garnet/rust/target/debug
extra-include-dirs:
/home/gthomas/code/garnet/rust
-- https://well-typed.com/blog/2026/02/hs-bindgen-alpha
-- Haskell.nix doesn't seem to like `tag: release-0.1-alpha`, which the blog post suggests
-- so we specify the equivalent commit SHAs manually instead
source-repository-package
type: git
location: https://github.com/well-typed/hs-bindgen
tag: e2a9260678d9fa76dab602a5a07927acada3be4f
subdir: c-expr-dsl c-expr-runtime hs-bindgen hs-bindgen-runtime
--sha256: 0nrs3iq0l5ha5kxyhqnlmvgi7734pmzyp3zf7p8s1gb21ylh4sy0
source-repository-package
type: git
location: https://github.com/well-typed/libclang
tag: b5ff712c91c039cde6720ffe2096a121d9f4d802
--sha256: 1lwjdxd2ahhkvyxrpli7z9z7ss4l94m2jaif8kg1i2yygbhksrb3
allow-newer: allow-newer:
*:base, *:base,
*:containers, *:containers,

128
generate-bindings Executable file
View File

@ -0,0 +1,128 @@
#!/usr/bin/env bash
set -euo pipefail
# TODO this is a complete vibe-coded hack, but the header patching at least is crucial
# Generate Haskell FFI bindings from Rust source code.
#
# Pipeline: cargo build -> cbindgen -> patch header -> hs-bindgen
#
# Prerequisites: run inside the Nix dev shell (provides gcc, cabal, etc.)
# cbindgen is fetched via `nix run nixpkgs#rust-cbindgen`.
SCRIPT_DIR="$(cd "$(dirname "$0")" && pwd)"
RUST_DIR="$SCRIPT_DIR/rust"
HASKELL_DIR="$SCRIPT_DIR/haskell"
HEADER_NAME="garnet_rs.h"
HEADER="$RUST_DIR/$HEADER_NAME"
# --- Step 1: Build Rust static library ---
echo "=== Building Rust library ==="
cargo build --manifest-path "$RUST_DIR/Cargo.toml"
# --- Step 2: Generate C header with cbindgen ---
echo "=== Running cbindgen ==="
nix run nixpkgs#rust-cbindgen -- \
--lang c \
--crate garnet-rs \
--output "$HEADER" \
"$RUST_DIR"
echo " Raw header written to $HEADER"
# --- Step 3: Patch the header for hs-bindgen compatibility ---
echo "=== Patching header ==="
# Two patches are needed:
#
# Patch 1: Replace cbindgen's enum pattern with typedef + #defines.
# cbindgen emits: enum Shape_Tag { Circle, Rectangle, }; typedef uint8_t Shape_Tag;
# hs-bindgen needs: typedef uint8_t Shape_Tag; #define Circle 0 ...
#
# Patch 2: Name anonymous unions inside structs.
# cbindgen emits: union { ... };
# hs-bindgen needs: union { ... } body;
awk '
# State machine for enum->typedef+define transformation
/^enum [A-Za-z_][A-Za-z0-9_]* \{$/ {
in_enum = 1
enum_name = $2
variant_count = 0
delete variants
next
}
in_enum && /^\};$/ {
# Next line should be: typedef <type> <enum_name>;
in_enum = 0
pending_enum = 1
next
}
in_enum {
# Collect variant names (strip trailing comma and whitespace)
v = $0
gsub(/^[[:space:]]+/, "", v)
gsub(/,[[:space:]]*$/, "", v)
if (v != "") {
variants[variant_count] = v
variant_count++
}
next
}
pending_enum && /^typedef [A-Za-z0-9_]+ / {
# Emit: typedef <type> <name>; then #define for each variant
print $0
for (i = 0; i < variant_count; i++) {
printf "#define %s %d\n", variants[i], i
}
pending_enum = 0
next
}
# Name anonymous unions: }; at end of union block inside struct -> } body;
/^ \};$/ && saw_union {
print " } body;"
saw_union = 0
next
}
/^ union \{$/ {
saw_union = 1
}
{ print }
' "$HEADER" > "${HEADER}.tmp" && mv "${HEADER}.tmp" "$HEADER"
echo " Patched header at $HEADER"
# --- Step 4: Derive system include paths for hs-bindgen's libclang ---
echo "=== Detecting system include paths ==="
# hs-bindgen uses libclang directly, which doesn't know about NixOS's
# non-standard include locations. We extract them from cpp -v and pass
# all of them — extra paths are harmless.
CLANG_OPTIONS=()
while IFS= read -r dir; do
CLANG_OPTIONS+=("--clang-option" "-isystem$dir")
done < <(echo | cpp -v 2>&1 | awk '/#include <\.\.\.> search starts here:/{f=1;next}/End of search list/{f=0}f{gsub(/^ +/,"");print}')
if [ ${#CLANG_OPTIONS[@]} -eq 0 ]; then
echo " WARNING: No system include paths detected. hs-bindgen may fail."
else
echo " Found ${#CLANG_OPTIONS[@]} clang options:"
for ((i=0; i<${#CLANG_OPTIONS[@]}; i+=2)); do
echo " ${CLANG_OPTIONS[i+1]}"
done
fi
# --- Step 5: Run hs-bindgen ---
echo "=== Running hs-bindgen ==="
cabal run -- hs-bindgen-cli preprocess \
--overwrite-files --create-output-dirs \
--unique-id com.garnet --enable-record-dot \
--hs-output-dir "$HASKELL_DIR/generated" --module GarnetRs \
"${CLANG_OPTIONS[@]}" \
-I "$RUST_DIR" "$HEADER_NAME"
echo "=== Done ==="
echo "Generated Haskell bindings in $HASKELL_DIR/generated/"
echo "Run 'cabal run garnet' to test."

9
haskell/exe/Main.hs
View File

@ -1,8 +1,9 @@
module Main (main) where module Main (main) where
import Foreign.C.String (CString, withCString) import Foreign.C
import GarnetRs.Safe
foreign import ccall safe "__c_hello" hello :: CString -> IO () import HsBindgen.Runtime.PtrConst
main :: IO () main :: IO ()
main = withCString "Haskell" hello main = do
withCString "Haskell" $ hello . unsafeFromPtr

22
haskell/garnet.cabal
View File

@ -7,6 +7,20 @@ maintainer:
george.thomas@obsidian.systems george.thomas@obsidian.systems
patrick.aldis@obsidian.systems patrick.aldis@obsidian.systems
library garnet-generated
hs-source-dirs: generated
exposed-modules:
GarnetRs
GarnetRs.Safe
GarnetRs.Unsafe
GarnetRs.FunPtr
default-language: Haskell2010
extra-bundled-libraries: garnet_rs
build-depends:
base,
hs-bindgen-runtime,
primitive,
executable garnet executable garnet
main-is: Main.hs main-is: Main.hs
hs-source-dirs: exe hs-source-dirs: exe
@ -32,11 +46,7 @@ executable garnet
-threaded -threaded
-rtsopts -rtsopts
-with-rtsopts=-N -with-rtsopts=-N
extra-lib-dirs:
-- TODO referring to parent triggers warning - maybe put Rust stuff in subdir
-- TODO bit weird to have both of these, but it's what the `cargo-cabal` setup script did
../rust/target/release
../rust/target/debug
extra-bundled-libraries: garnet_rs
build-depends: build-depends:
base >= 4.14, base >= 4.14,
garnet-generated,
hs-bindgen-runtime,

476
haskell/generated/GarnetRs.hs Normal file
View File

@ -0,0 +1,476 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
module GarnetRs where
import qualified Data.Array.Byte
import qualified Data.Bits as Bits
import qualified Data.Ix as Ix
import qualified Data.Primitive.Types
import qualified Data.Proxy
import qualified Foreign as F
import qualified Foreign.C as FC
import qualified GHC.Generics
import qualified GHC.Ptr as Ptr
import qualified GHC.Records
import qualified HsBindgen.Runtime.HasCField
import qualified HsBindgen.Runtime.Internal.Bitfield
import qualified HsBindgen.Runtime.Internal.ByteArray
import qualified HsBindgen.Runtime.Internal.HasFFIType
import qualified HsBindgen.Runtime.Internal.SizedByteArray
import qualified HsBindgen.Runtime.LibC
import qualified HsBindgen.Runtime.Marshal
import Data.Bits (FiniteBits)
import HsBindgen.Runtime.Internal.TypeEquality (TyEq)
import Prelude ((<*>), (>>), Bounded, Enum, Eq, Int, Integral, Num, Ord, Read, Real, Show, pure)
{-| __C declaration:__ @struct T@
__defined at:__ @garnet_rs.h 6:16@
__exported by:__ @garnet_rs.h@
-}
data T = T
{ a :: FC.CBool
{- ^ __C declaration:__ @a@
__defined at:__ @garnet_rs.h 7:8@
__exported by:__ @garnet_rs.h@
-}
, b :: HsBindgen.Runtime.LibC.Word8
{- ^ __C declaration:__ @b@
__defined at:__ @garnet_rs.h 8:11@
__exported by:__ @garnet_rs.h@
-}
}
deriving stock (GHC.Generics.Generic)
deriving stock (Eq, Show)
instance HsBindgen.Runtime.Marshal.StaticSize T where
staticSizeOf = \_ -> (2 :: Int)
staticAlignment = \_ -> (1 :: Int)
instance HsBindgen.Runtime.Marshal.ReadRaw T where
readRaw =
\ptr0 ->
pure T
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"a") ptr0
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"b") ptr0
instance HsBindgen.Runtime.Marshal.WriteRaw T where
writeRaw =
\ptr0 ->
\s1 ->
case s1 of
T a2 b3 ->
HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"a") ptr0 a2
>> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"b") ptr0 b3
deriving via HsBindgen.Runtime.Marshal.EquivStorable T instance F.Storable T
instance HsBindgen.Runtime.HasCField.HasCField T "a" where
type CFieldType T "a" = FC.CBool
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T) "a")
) => GHC.Records.HasField "a" (Ptr.Ptr T) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"a")
instance HsBindgen.Runtime.HasCField.HasCField T "b" where
type CFieldType T "b" = HsBindgen.Runtime.LibC.Word8
offset# = \_ -> \_ -> 1
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType T) "b")
) => GHC.Records.HasField "b" (Ptr.Ptr T) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"b")
{-| __C declaration:__ @Shape_Tag@
__defined at:__ @garnet_rs.h 11:17@
__exported by:__ @garnet_rs.h@
-}
newtype Shape_Tag = Shape_Tag
{ unwrap :: HsBindgen.Runtime.LibC.Word8
}
deriving stock (GHC.Generics.Generic)
deriving stock (Eq, Ord, Read, Show)
deriving newtype
( HsBindgen.Runtime.Marshal.StaticSize
, HsBindgen.Runtime.Marshal.ReadRaw
, HsBindgen.Runtime.Marshal.WriteRaw
, F.Storable
, HsBindgen.Runtime.Internal.HasFFIType.HasFFIType
, Data.Primitive.Types.Prim
, HsBindgen.Runtime.Internal.Bitfield.Bitfield
, Bits.Bits
, Bounded
, Enum
, FiniteBits
, Integral
, Ix.Ix
, Num
, Real
)
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_Tag) "unwrap")
) => GHC.Records.HasField "unwrap" (Ptr.Ptr Shape_Tag) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"unwrap")
instance HsBindgen.Runtime.HasCField.HasCField Shape_Tag "unwrap" where
type CFieldType Shape_Tag "unwrap" =
HsBindgen.Runtime.LibC.Word8
offset# = \_ -> \_ -> 0
{-| __C declaration:__ @Circle@
__defined at:__ @garnet_rs.h 12:9@
__exported by:__ @garnet_rs.h@
-}
circle :: FC.CInt
circle = (0 :: FC.CInt)
{-| __C declaration:__ @Rectangle@
__defined at:__ @garnet_rs.h 13:9@
__exported by:__ @garnet_rs.h@
-}
rectangle :: FC.CInt
rectangle = (1 :: FC.CInt)
{-| __C declaration:__ @struct Circle_Body@
__defined at:__ @garnet_rs.h 15:16@
__exported by:__ @garnet_rs.h@
-}
data Circle_Body = Circle_Body
{ radius :: FC.CDouble
{- ^ __C declaration:__ @radius@
__defined at:__ @garnet_rs.h 16:10@
__exported by:__ @garnet_rs.h@
-}
}
deriving stock (GHC.Generics.Generic)
deriving stock (Eq, Show)
instance HsBindgen.Runtime.Marshal.StaticSize Circle_Body where
staticSizeOf = \_ -> (8 :: Int)
staticAlignment = \_ -> (8 :: Int)
instance HsBindgen.Runtime.Marshal.ReadRaw Circle_Body where
readRaw =
\ptr0 ->
pure Circle_Body
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"radius") ptr0
instance HsBindgen.Runtime.Marshal.WriteRaw Circle_Body where
writeRaw =
\ptr0 ->
\s1 ->
case s1 of
Circle_Body radius2 ->
HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"radius") ptr0 radius2
deriving via HsBindgen.Runtime.Marshal.EquivStorable Circle_Body instance F.Storable Circle_Body
instance HsBindgen.Runtime.HasCField.HasCField Circle_Body "radius" where
type CFieldType Circle_Body "radius" = FC.CDouble
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Circle_Body) "radius")
) => GHC.Records.HasField "radius" (Ptr.Ptr Circle_Body) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"radius")
{-| __C declaration:__ @struct Rectangle_Body@
__defined at:__ @garnet_rs.h 19:16@
__exported by:__ @garnet_rs.h@
-}
data Rectangle_Body = Rectangle_Body
{ width :: FC.CDouble
{- ^ __C declaration:__ @width@
__defined at:__ @garnet_rs.h 20:10@
__exported by:__ @garnet_rs.h@
-}
, height :: FC.CDouble
{- ^ __C declaration:__ @height@
__defined at:__ @garnet_rs.h 21:10@
__exported by:__ @garnet_rs.h@
-}
}
deriving stock (GHC.Generics.Generic)
deriving stock (Eq, Show)
instance HsBindgen.Runtime.Marshal.StaticSize Rectangle_Body where
staticSizeOf = \_ -> (16 :: Int)
staticAlignment = \_ -> (8 :: Int)
instance HsBindgen.Runtime.Marshal.ReadRaw Rectangle_Body where
readRaw =
\ptr0 ->
pure Rectangle_Body
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"width") ptr0
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"height") ptr0
instance HsBindgen.Runtime.Marshal.WriteRaw Rectangle_Body where
writeRaw =
\ptr0 ->
\s1 ->
case s1 of
Rectangle_Body width2 height3 ->
HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"width") ptr0 width2
>> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"height") ptr0 height3
deriving via HsBindgen.Runtime.Marshal.EquivStorable Rectangle_Body instance F.Storable Rectangle_Body
instance HsBindgen.Runtime.HasCField.HasCField Rectangle_Body "width" where
type CFieldType Rectangle_Body "width" = FC.CDouble
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Rectangle_Body) "width")
) => GHC.Records.HasField "width" (Ptr.Ptr Rectangle_Body) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"width")
instance HsBindgen.Runtime.HasCField.HasCField Rectangle_Body "height" where
type CFieldType Rectangle_Body "height" = FC.CDouble
offset# = \_ -> \_ -> 8
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Rectangle_Body) "height")
) => GHC.Records.HasField "height" (Ptr.Ptr Rectangle_Body) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"height")
{-| __C declaration:__ @union \@Shape_body@
__defined at:__ @garnet_rs.h 26:3@
__exported by:__ @garnet_rs.h@
-}
newtype Shape_body = Shape_body
{ unwrap :: Data.Array.Byte.ByteArray
}
deriving stock (GHC.Generics.Generic)
deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.StaticSize Shape_body
deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.ReadRaw Shape_body
deriving via (HsBindgen.Runtime.Internal.SizedByteArray.SizedByteArray 16) 8 instance HsBindgen.Runtime.Marshal.WriteRaw Shape_body
deriving via HsBindgen.Runtime.Marshal.EquivStorable Shape_body instance F.Storable Shape_body
{-|
__See:__ 'set_shape_body_circle'
__C declaration:__ @circle@
__defined at:__ @garnet_rs.h 27:17@
__exported by:__ @garnet_rs.h@
-}
get_shape_body_circle ::
Shape_body
-> Circle_Body
get_shape_body_circle =
HsBindgen.Runtime.Internal.ByteArray.getUnionPayload
{-|
__See:__ 'get_shape_body_circle'
-}
set_shape_body_circle ::
Circle_Body
-> Shape_body
set_shape_body_circle =
HsBindgen.Runtime.Internal.ByteArray.setUnionPayload
{-|
__See:__ 'set_shape_body_rectangle'
__C declaration:__ @rectangle@
__defined at:__ @garnet_rs.h 28:20@
__exported by:__ @garnet_rs.h@
-}
get_shape_body_rectangle ::
Shape_body
-> Rectangle_Body
get_shape_body_rectangle =
HsBindgen.Runtime.Internal.ByteArray.getUnionPayload
{-|
__See:__ 'get_shape_body_rectangle'
-}
set_shape_body_rectangle ::
Rectangle_Body
-> Shape_body
set_shape_body_rectangle =
HsBindgen.Runtime.Internal.ByteArray.setUnionPayload
instance HsBindgen.Runtime.HasCField.HasCField Shape_body "circle" where
type CFieldType Shape_body "circle" = Circle_Body
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_body) "circle")
) => GHC.Records.HasField "circle" (Ptr.Ptr Shape_body) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"circle")
instance HsBindgen.Runtime.HasCField.HasCField Shape_body "rectangle" where
type CFieldType Shape_body "rectangle" =
Rectangle_Body
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape_body) "rectangle")
) => GHC.Records.HasField "rectangle" (Ptr.Ptr Shape_body) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"rectangle")
{-| __C declaration:__ @struct Shape@
__defined at:__ @garnet_rs.h 24:16@
__exported by:__ @garnet_rs.h@
-}
data Shape = Shape
{ tag :: Shape_Tag
{- ^ __C declaration:__ @tag@
__defined at:__ @garnet_rs.h 25:13@
__exported by:__ @garnet_rs.h@
-}
, body :: Shape_body
{- ^ __C declaration:__ @body@
__defined at:__ @garnet_rs.h 29:5@
__exported by:__ @garnet_rs.h@
-}
}
deriving stock (GHC.Generics.Generic)
instance HsBindgen.Runtime.Marshal.StaticSize Shape where
staticSizeOf = \_ -> (24 :: Int)
staticAlignment = \_ -> (8 :: Int)
instance HsBindgen.Runtime.Marshal.ReadRaw Shape where
readRaw =
\ptr0 ->
pure Shape
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"tag") ptr0
<*> HsBindgen.Runtime.HasCField.readRaw (Data.Proxy.Proxy @"body") ptr0
instance HsBindgen.Runtime.Marshal.WriteRaw Shape where
writeRaw =
\ptr0 ->
\s1 ->
case s1 of
Shape tag2 body3 ->
HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"tag") ptr0 tag2
>> HsBindgen.Runtime.HasCField.writeRaw (Data.Proxy.Proxy @"body") ptr0 body3
deriving via HsBindgen.Runtime.Marshal.EquivStorable Shape instance F.Storable Shape
instance HsBindgen.Runtime.HasCField.HasCField Shape "tag" where
type CFieldType Shape "tag" = Shape_Tag
offset# = \_ -> \_ -> 0
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape) "tag")
) => GHC.Records.HasField "tag" (Ptr.Ptr Shape) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"tag")
instance HsBindgen.Runtime.HasCField.HasCField Shape "body" where
type CFieldType Shape "body" = Shape_body
offset# = \_ -> \_ -> 8
instance ( TyEq ty ((HsBindgen.Runtime.HasCField.CFieldType Shape) "body")
) => GHC.Records.HasField "body" (Ptr.Ptr Shape) (Ptr.Ptr ty) where
getField =
HsBindgen.Runtime.HasCField.fromPtr (Data.Proxy.Proxy @"body")

47
haskell/generated/GarnetRs/FunPtr.hs Normal file
View File

@ -0,0 +1,47 @@
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK prune #-}
module GarnetRs.FunPtr where
import qualified Foreign.C as FC
import qualified GHC.IO.Unsafe
import qualified GHC.Ptr as Ptr
import qualified HsBindgen.Runtime.Internal.CAPI
import qualified HsBindgen.Runtime.Internal.HasFFIType
import qualified HsBindgen.Runtime.PtrConst
import Data.Void (Void)
import Prelude (IO)
$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines
[ "#include <garnet_rs.h>"
, "/* com_garnet_GarnetRs_get_hello */"
, "__attribute__ ((const))"
, "void (*hs_bindgen_faf62265b53521d3 (void)) ("
, " char const *arg1"
, ")"
, "{"
, " return &hello;"
, "}"
]))
-- __unique:__ @com_garnet_GarnetRs_get_hello@
foreign import ccall unsafe "hs_bindgen_faf62265b53521d3" hs_bindgen_faf62265b53521d3_base ::
IO (Ptr.FunPtr Void)
-- __unique:__ @com_garnet_GarnetRs_get_hello@
hs_bindgen_faf62265b53521d3 :: IO (Ptr.FunPtr ((HsBindgen.Runtime.PtrConst.PtrConst FC.CChar) -> IO ()))
hs_bindgen_faf62265b53521d3 =
HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_faf62265b53521d3_base
{-# NOINLINE hello #-}
{-| __C declaration:__ @hello@
__defined at:__ @garnet_rs.h 6:6@
__exported by:__ @garnet_rs.h@
-}
hello :: Ptr.FunPtr ((HsBindgen.Runtime.PtrConst.PtrConst FC.CChar) -> IO ())
hello =
GHC.IO.Unsafe.unsafePerformIO hs_bindgen_faf62265b53521d3

48
haskell/generated/GarnetRs/Safe.hs Normal file
View File

@ -0,0 +1,48 @@
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK prune #-}
module GarnetRs.Safe where
import qualified Foreign.C as FC
import qualified GHC.Ptr as Ptr
import qualified HsBindgen.Runtime.Internal.CAPI
import qualified HsBindgen.Runtime.Internal.HasFFIType
import qualified HsBindgen.Runtime.PtrConst
import Data.Void (Void)
import Prelude (IO)
$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines
[ "#include <garnet_rs.h>"
, "void hs_bindgen_433ea2a26af4e593 ("
, " char const *arg1"
, ")"
, "{"
, " hello(arg1);"
, "}"
]))
-- __unique:__ @com_garnet_GarnetRs_Safe_hello@
foreign import ccall safe "hs_bindgen_433ea2a26af4e593" hs_bindgen_433ea2a26af4e593_base ::
Ptr.Ptr Void
-> IO ()
-- __unique:__ @com_garnet_GarnetRs_Safe_hello@
hs_bindgen_433ea2a26af4e593 ::
HsBindgen.Runtime.PtrConst.PtrConst FC.CChar
-> IO ()
hs_bindgen_433ea2a26af4e593 =
HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_433ea2a26af4e593_base
{-| __C declaration:__ @hello@
__defined at:__ @garnet_rs.h 6:6@
__exported by:__ @garnet_rs.h@
-}
hello ::
HsBindgen.Runtime.PtrConst.PtrConst FC.CChar
-- ^ __C declaration:__ @c@
-> IO ()
hello = hs_bindgen_433ea2a26af4e593

48
haskell/generated/GarnetRs/Unsafe.hs Normal file
View File

@ -0,0 +1,48 @@
{-# LANGUAGE CApiFFI #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK prune #-}
module GarnetRs.Unsafe where
import qualified Foreign.C as FC
import qualified GHC.Ptr as Ptr
import qualified HsBindgen.Runtime.Internal.CAPI
import qualified HsBindgen.Runtime.Internal.HasFFIType
import qualified HsBindgen.Runtime.PtrConst
import Data.Void (Void)
import Prelude (IO)
$(HsBindgen.Runtime.Internal.CAPI.addCSource (HsBindgen.Runtime.Internal.CAPI.unlines
[ "#include <garnet_rs.h>"
, "void hs_bindgen_2dfe97662a4d6377 ("
, " char const *arg1"
, ")"
, "{"
, " hello(arg1);"
, "}"
]))
-- __unique:__ @com_garnet_GarnetRs_Unsafe_hello@
foreign import ccall unsafe "hs_bindgen_2dfe97662a4d6377" hs_bindgen_2dfe97662a4d6377_base ::
Ptr.Ptr Void
-> IO ()
-- __unique:__ @com_garnet_GarnetRs_Unsafe_hello@
hs_bindgen_2dfe97662a4d6377 ::
HsBindgen.Runtime.PtrConst.PtrConst FC.CChar
-> IO ()
hs_bindgen_2dfe97662a4d6377 =
HsBindgen.Runtime.Internal.HasFFIType.fromFFIType hs_bindgen_2dfe97662a4d6377_base
{-| __C declaration:__ @hello@
__defined at:__ @garnet_rs.h 6:6@
__exported by:__ @garnet_rs.h@
-}
hello ::
HsBindgen.Runtime.PtrConst.PtrConst FC.CChar
-- ^ __C declaration:__ @c@
-> IO ()
hello = hs_bindgen_2dfe97662a4d6377

212
rust/Cargo.lock generated
View File

@ -2,218 +2,6 @@
# It is not intended for manual editing. # It is not intended for manual editing.
version = 4 version = 4
[[package]]
name = "antlion"
version = "0.3.2"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "cd743dc9b5cf465db1be79d28b4bfd7fa143d289546afeea5dc933551883e1f6"
dependencies = [
"proc-macro2",
"quote",
]
[[package]]
name = "displaydoc"
version = "0.2.5"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "97369cbbc041bc366949bc74d34658d6cda5621039731c6310521892a3a20ae0"
dependencies = [
"proc-macro2",
"quote",
"syn 2.0.116",
]
[[package]] [[package]]
name = "garnet-rs" name = "garnet-rs"
version = "0.1.0" version = "0.1.0"
dependencies = [
"hs-bindgen",
]
[[package]]
name = "hs-bindgen"
version = "0.8.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3e9723a81f9f23c3e52b01ce72db20c7ab384c8618b1032eea04985260d10fc7"
dependencies = [
"hs-bindgen-attribute",
"hs-bindgen-traits",
]
[[package]]
name = "hs-bindgen-attribute"
version = "0.8.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e57fc3cb0491f749fc50e7cf186c189b64af557edb9f78e36eb78bb9021d6624"
dependencies = [
"antlion",
"displaydoc",
"hs-bindgen-types",
"lazy_static",
"quote",
"rustc_version",
"semver 1.0.27",
"serde",
"syn 1.0.109",
"thiserror",
"toml",
]
[[package]]
name = "hs-bindgen-traits"
version = "0.8.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e92e839254ee5975299f64183e8346548c4ba5e4ee0253a05426891a6f135a6a"
[[package]]
name = "hs-bindgen-types"
version = "0.8.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "c2d986de5641ea4aa8025589d7243e403961fb0f5572c4dd4764a1bb4a01768c"
dependencies = [
"displaydoc",
"proc-macro2",
"quote",
"thiserror",
]
[[package]]
name = "lazy_static"
version = "1.5.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "bbd2bcb4c963f2ddae06a2efc7e9f3591312473c50c6685e1f298068316e66fe"
[[package]]
name = "proc-macro2"
version = "1.0.106"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "8fd00f0bb2e90d81d1044c2b32617f68fcb9fa3bb7640c23e9c748e53fb30934"
dependencies = [
"unicode-ident",
]
[[package]]
name = "quote"
version = "1.0.44"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "21b2ebcf727b7760c461f091f9f0f539b77b8e87f2fd88131e7f1b433b3cece4"
dependencies = [
"proc-macro2",
]
[[package]]
name = "rustc_version"
version = "0.2.3"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "138e3e0acb6c9fb258b19b67cb8abd63c00679d2851805ea151465464fe9030a"
dependencies = [
"semver 0.9.0",
]
[[package]]
name = "semver"
version = "0.9.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "1d7eb9ef2c18661902cc47e535f9bc51b78acd254da71d375c2f6720d9a40403"
dependencies = [
"semver-parser",
]
[[package]]
name = "semver"
version = "1.0.27"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d767eb0aabc880b29956c35734170f26ed551a859dbd361d140cdbeca61ab1e2"
[[package]]
name = "semver-parser"
version = "0.7.0"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "388a1df253eca08550bef6c72392cfe7c30914bf41df5269b68cbd6ff8f570a3"
[[package]]
name = "serde"
version = "1.0.228"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "9a8e94ea7f378bd32cbbd37198a4a91436180c5bb472411e48b5ec2e2124ae9e"
dependencies = [
"serde_core",
"serde_derive",
]
[[package]]
name = "serde_core"
version = "1.0.228"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "41d385c7d4ca58e59fc732af25c3983b67ac852c1a25000afe1175de458b67ad"
dependencies = [
"serde_derive",
]
[[package]]
name = "serde_derive"
version = "1.0.228"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "d540f220d3187173da220f885ab66608367b6574e925011a9353e4badda91d79"
dependencies = [
"proc-macro2",
"quote",
"syn 2.0.116",
]
[[package]]
name = "syn"
version = "1.0.109"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "72b64191b275b66ffe2469e8af2c1cfe3bafa67b529ead792a6d0160888b4237"
dependencies = [
"proc-macro2",
"quote",
"unicode-ident",
]
[[package]]
name = "syn"
version = "2.0.116"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "3df424c70518695237746f84cede799c9c58fcb37450d7b23716568cc8bc69cb"
dependencies = [
"proc-macro2",
"quote",
"unicode-ident",
]
[[package]]
name = "thiserror"
version = "1.0.69"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "b6aaf5339b578ea85b50e080feb250a3e8ae8cfcdff9a461c9ec2904bc923f52"
dependencies = [
"thiserror-impl",
]
[[package]]
name = "thiserror-impl"
version = "1.0.69"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "4fee6c4efc90059e10f81e6d42c60a18f76588c3d74cb83a0b242a2b6c7504c1"
dependencies = [
"proc-macro2",
"quote",
"syn 2.0.116",
]
[[package]]
name = "toml"
version = "0.5.11"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "f4f7f0dd8d50a853a531c426359045b1998f04219d88799810762cd4ad314234"
dependencies = [
"serde",
]
[[package]]
name = "unicode-ident"
version = "1.0.24"
source = "registry+https://github.com/rust-lang/crates.io-index"
checksum = "e6e4313cd5fcd3dad5cafa179702e2b244f760991f45397d14d4ebf38247da75"

3
rust/Cargo.toml
View File

@ -6,6 +6,3 @@ edition = "2024"
[lib] [lib]
path = "lib.rs" path = "lib.rs"
crate-type = ["staticlib"] crate-type = ["staticlib"]
[dependencies]
hs-bindgen = { version = "0.8", features = ["full"] }

6
rust/garnet_rs.h Normal file
View File

@ -0,0 +1,6 @@
#include <stdarg.h>
#include <stdbool.h>
#include <stdint.h>
#include <stdlib.h>
void hello(const char *c);

13
rust/hsbindgen.toml
View File

@ -1,13 +0,0 @@
# Since the only `.cabal` format parser implementation and specification live
# in Cabal itself ... this deadly simple config file is used by `hs-bindgen`
# Rust crate to get needed data (like default exposed module name).
default = "GarnetRs"
# There is an unlikely future where instead we have a Rust `.cabal` parser,
# that most likely would rely under the hood on a Haskell static lib wrapper
# of `Cabal.Parse` or https://hackage.haskell.org/package/Cabal-syntax library.
# But even in this case, it would be nice to know the `cargo-cabal` version that
# generated the `.cabal` file used.
version = "0.8.0"

10
rust/lib.rs
View File

@ -1,6 +1,10 @@
use hs_bindgen::*; use std::ffi::{CStr, c_char};
#[hs_bindgen(hello :: CString -> IO (()))] fn say_hello(name: &str) {
fn hello(name: &str) {
println!("Hello from Rust, {name}!"); println!("Hello from Rust, {name}!");
} }
#[unsafe(no_mangle)]
extern "C" fn hello(c: *const c_char) -> () {
say_hello(unsafe { CStr::from_ptr(c) }.to_str().unwrap())
}