diff --git a/haskell/exe/GarnetRs/Wrapped.hs b/haskell/exe/GarnetRs/Wrapped.hs new file mode 100644 index 0000000..504643e --- /dev/null +++ b/haskell/exe/GarnetRs/Wrapped.hs @@ -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 diff --git a/haskell/exe/Main.hs b/haskell/exe/Main.hs index 0b25177..1ef8c68 100644 --- a/haskell/exe/Main.hs +++ b/haskell/exe/Main.hs @@ -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 diff --git a/haskell/garnet.cabal b/haskell/garnet.cabal index b031638..37a80aa 100644 --- a/haskell/garnet.cabal +++ b/haskell/garnet.cabal @@ -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: