diff --git a/cabal.project b/cabal.project index 9eae6eb..b98686e 100644 --- a/cabal.project +++ b/cabal.project @@ -1,5 +1,28 @@ 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: *:base, *:containers, diff --git a/generate-bindings b/generate-bindings new file mode 100755 index 0000000..30d4b1b --- /dev/null +++ b/generate-bindings @@ -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 ; + 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 ; 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." diff --git a/haskell/exe/Main.hs b/haskell/exe/Main.hs index 69d00ee..de97264 100644 --- a/haskell/exe/Main.hs +++ b/haskell/exe/Main.hs @@ -1,8 +1,9 @@ module Main (main) where -import Foreign.C.String (CString, withCString) - -foreign import ccall safe "__c_hello" hello :: CString -> IO () +import Foreign.C +import GarnetRs.Safe +import HsBindgen.Runtime.PtrConst main :: IO () -main = withCString "Haskell" hello +main = do + withCString "Haskell" $ hello . unsafeFromPtr diff --git a/haskell/garnet.cabal b/haskell/garnet.cabal index 0ccb29b..d07f408 100644 --- a/haskell/garnet.cabal +++ b/haskell/garnet.cabal @@ -7,6 +7,20 @@ maintainer: george.thomas@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 main-is: Main.hs hs-source-dirs: exe @@ -32,11 +46,7 @@ executable garnet -threaded -rtsopts -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: base >= 4.14, + garnet-generated, + hs-bindgen-runtime, diff --git a/haskell/generated/GarnetRs.hs b/haskell/generated/GarnetRs.hs new file mode 100644 index 0000000..07ba5b8 --- /dev/null +++ b/haskell/generated/GarnetRs.hs @@ -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") diff --git a/haskell/generated/GarnetRs/FunPtr.hs b/haskell/generated/GarnetRs/FunPtr.hs new file mode 100644 index 0000000..8e6972e --- /dev/null +++ b/haskell/generated/GarnetRs/FunPtr.hs @@ -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 " + , "/* 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 diff --git a/haskell/generated/GarnetRs/Safe.hs b/haskell/generated/GarnetRs/Safe.hs new file mode 100644 index 0000000..efb2b0e --- /dev/null +++ b/haskell/generated/GarnetRs/Safe.hs @@ -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 " + , "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 diff --git a/haskell/generated/GarnetRs/Unsafe.hs b/haskell/generated/GarnetRs/Unsafe.hs new file mode 100644 index 0000000..41ba945 --- /dev/null +++ b/haskell/generated/GarnetRs/Unsafe.hs @@ -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 " + , "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 diff --git a/rust/Cargo.lock b/rust/Cargo.lock index 5c55783..abaa784 100644 --- a/rust/Cargo.lock +++ b/rust/Cargo.lock @@ -2,218 +2,6 @@ # It is not intended for manual editing. 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]] name = "garnet-rs" 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" diff --git a/rust/Cargo.toml b/rust/Cargo.toml index 5c7c148..42688cf 100644 --- a/rust/Cargo.toml +++ b/rust/Cargo.toml @@ -6,6 +6,3 @@ edition = "2024" [lib] path = "lib.rs" crate-type = ["staticlib"] - -[dependencies] -hs-bindgen = { version = "0.8", features = ["full"] } diff --git a/rust/garnet_rs.h b/rust/garnet_rs.h new file mode 100644 index 0000000..ae756f1 --- /dev/null +++ b/rust/garnet_rs.h @@ -0,0 +1,6 @@ +#include +#include +#include +#include + +void hello(const char *c); diff --git a/rust/hsbindgen.toml b/rust/hsbindgen.toml deleted file mode 100644 index dbd135b..0000000 --- a/rust/hsbindgen.toml +++ /dev/null @@ -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" \ No newline at end of file diff --git a/rust/lib.rs b/rust/lib.rs index cf17a97..0d4431b 100644 --- a/rust/lib.rs +++ b/rust/lib.rs @@ -1,6 +1,10 @@ -use hs_bindgen::*; +use std::ffi::{CStr, c_char}; -#[hs_bindgen(hello :: CString -> IO (()))] -fn hello(name: &str) { +fn say_hello(name: &str) { 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()) +}