91 lines
2.7 KiB
Haskell
91 lines
2.7 KiB
Haskell
-- 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 (..),
|
|
Raw.E (..),
|
|
-- TODO hmm, we don't really want to have to list all of these...
|
|
-- is there an option to make them not be patterns at all?
|
|
pattern Raw.E1,
|
|
pattern Raw.E2,
|
|
pattern Raw.E3,
|
|
Shape (..),
|
|
BTree (..),
|
|
hello,
|
|
helloStruct,
|
|
helloEnum,
|
|
helloShape,
|
|
add,
|
|
sumTree,
|
|
sumSlice,
|
|
printOptional,
|
|
) where
|
|
|
|
import Control.Monad.Cont
|
|
import Control.Monad.Trans
|
|
import Data.ByteString
|
|
import Data.Function
|
|
import Data.Vector.Storable qualified as V
|
|
import Data.Word
|
|
import Foreign
|
|
import Foreign.C
|
|
import GarnetRs.Raw qualified as Raw
|
|
import HsBindgen.Runtime.PtrConst
|
|
import System.IO.Unsafe
|
|
|
|
data T = T
|
|
{ a :: Bool
|
|
, b :: Word8
|
|
}
|
|
convertT :: T -> Raw.T
|
|
convertT T{a, b} = Raw.T{a = fromBool a, b}
|
|
|
|
data Shape
|
|
= Circle CDouble
|
|
| Rectangle CDouble CDouble
|
|
convertShape :: Shape -> Raw.Shape
|
|
convertShape = \case
|
|
Circle r -> Raw.Shape Raw.Circle $ Raw.set_shape_circle_circle $ Raw.Circle_Body r
|
|
Rectangle w h -> Raw.Shape Raw.Rectangle $ Raw.set_shape_circle_rectangle $ Raw.Rectangle_Body w h
|
|
|
|
data BTree a
|
|
= Leaf a
|
|
| Fork (BTree a) (BTree a)
|
|
withBTree :: BTree Int64 -> (Raw.BTreeC -> IO a) -> IO a
|
|
withBTree =
|
|
runContT . fix \f -> \case
|
|
Leaf v -> pure $ Raw.BTreeC Raw.Leaf $ Raw.set_bTreeC_leaf_leaf $ Raw.Leaf_Body v
|
|
Fork l r -> do
|
|
lRaw <- f l
|
|
rRaw <- f r
|
|
lPtr <- ContT alloca
|
|
rPtr <- ContT alloca
|
|
lift $ poke lPtr lRaw >> poke rPtr rRaw
|
|
pure . Raw.BTreeC Raw.Fork . Raw.set_bTreeC_leaf_fork $
|
|
Raw.Fork_Body (unsafeFromPtr lPtr) (unsafeFromPtr rPtr)
|
|
|
|
hello :: ByteString -> IO ()
|
|
hello bs = useAsCString bs \ptr -> Raw.hello $ unsafeFromPtr ptr
|
|
|
|
helloStruct :: T -> IO ()
|
|
helloStruct t = with (convertT t) \ptr -> Raw.hello_struct $ unsafeFromPtr ptr
|
|
|
|
helloEnum :: Raw.E -> IO ()
|
|
helloEnum e = with e \ptr -> Raw.hello_enum $ unsafeFromPtr ptr
|
|
|
|
helloShape :: Shape -> IO ()
|
|
helloShape s = with (convertShape s) \ptr -> Raw.hello_shape $ unsafeFromPtr ptr
|
|
|
|
add :: Int64 -> Int64 -> Int64
|
|
add = Raw.add
|
|
|
|
sumTree :: BTree Int64 -> Int64
|
|
sumTree t = unsafePerformIO $ withBTree t \tc -> with tc \ptr -> Raw.sum_tree $ unsafeFromPtr ptr
|
|
|
|
sumSlice :: V.Vector Int64 -> Int64
|
|
sumSlice v = unsafePerformIO $ V.unsafeWith v \ptr -> Raw.sum_slice (unsafeFromPtr ptr) (fromIntegral $ V.length v)
|
|
|
|
printOptional :: Maybe Int8 -> IO ()
|
|
printOptional = \case
|
|
Nothing -> Raw.print_optional $ unsafeFromPtr nullPtr
|
|
Just t -> with t \ptr -> Raw.print_optional $ unsafeFromPtr ptr
|