garnet/exe/GarnetRs/Wrapped.hs

-- 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 (..),
    BTree (..),
    hello,
    helloStruct,
    helloShape,
    add,
    sumTree,
) 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 = 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_body_circle $ Raw.Circle_Body r
    Rectangle w h -> Raw.Shape Raw.Rectangle $ Raw.set_shape_body_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 = flip \f -> \case
    Leaf v ->
        f $ Raw.BTreeC Raw.Leaf $ Raw.set_bTreeC_body_leaf $ Raw.Leaf_Body v
    Fork l r ->
        withBTree l \lRaw ->
            withBTree r \rRaw ->
                alloca \lPtr ->
                    alloca \rPtr -> do
                        poke lPtr lRaw
                        poke rPtr rRaw
                        f
                            . Raw.BTreeC Raw.Fork
                            . Raw.set_bTreeC_body_fork
                            $ Raw.Fork_Body (unsafeFromPtr lPtr) (unsafeFromPtr rPtr)

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

add :: Int64 -> Int64 -> Int64
add = Raw.add

sumTree :: BTree Int64 -> IO Int64
sumTree = flip withBTree Raw.sum_tree