Create manual high level wrapper

This commit is contained in:
George Thomas 2026-02-19 13:44:16 +00:00
parent f1ec06fcca
commit 0e54cccd74
3 changed files with 48 additions and 9 deletions

View File

@ -0,0 +1,41 @@
-- TODO automate this sort of high level wrapper boilerplate
-- or look at upstream plans: https://github.com/well-typed/hs-bindgen/issues?q=state%3Aopen%20label%3A%22highlevel%22
module GarnetRs.Wrapped (
T (..),
Shape (..),
hello,
helloStruct,
helloShape,
) where
import Data.ByteString
import Data.Word
import Foreign
import Foreign.C
import GarnetRs qualified as Raw
import GarnetRs.Safe qualified as Raw
import HsBindgen.Runtime.PtrConst
data T = T
{ a :: Bool
, b :: Word8
}
convertT :: T -> Raw.T
convertT T{a, b} = Raw.T{a = CBool $ fromBool a, b}
data Shape
= Circle CDouble
| Rectangle CDouble CDouble
convertShape :: Shape -> Raw.Shape
convertShape = \case
Circle r -> Raw.Shape (Raw.Shape_Tag 0) $ Raw.set_shape_body_circle $ Raw.Circle_Body r
Rectangle w h -> Raw.Shape (Raw.Shape_Tag 1) $ Raw.set_shape_body_rectangle $ Raw.Rectangle_Body w h
hello :: ByteString -> IO ()
hello s = useAsCString s $ Raw.hello . unsafeFromPtr
helloStruct :: T -> IO ()
helloStruct = Raw.hello_struct . convertT
helloShape :: Shape -> IO ()
helloShape = Raw.hello_shape . convertShape

View File

@ -1,14 +1,10 @@
module Main (main) where
import Data.ByteString
import Foreign.C
import GarnetRs
import GarnetRs.Safe
import HsBindgen.Runtime.PtrConst
import GarnetRs.Wrapped
main :: IO ()
main = do
useAsCString "Haskell" $ hello . unsafeFromPtr
hello_struct T{a = CBool 1, b = 42}
hello_shape $ Shape (Shape_Tag 0) $ set_shape_body_circle $ Circle_Body 3.14
hello_shape $ Shape (Shape_Tag 1) $ set_shape_body_rectangle $ Rectangle_Body 10.0 5.0
hello "Haskell"
helloStruct T{a = True, b = 42}
helloShape $ Circle 3.14
helloShape $ Rectangle 10.0 5.0

View File

@ -23,6 +23,8 @@ library garnet-generated
executable garnet
main-is: Main.hs
other-modules:
GarnetRs.Wrapped
hs-source-dirs: exe
default-language: GHC2024
default-extensions: