Create manual high level wrapper
This commit is contained in:
parent
f1ec06fcca
commit
0e54cccd74
41
haskell/exe/GarnetRs/Wrapped.hs
Normal file
41
haskell/exe/GarnetRs/Wrapped.hs
Normal 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
|
||||
@ -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
|
||||
|
||||
@ -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:
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user