{-# LANGUAGE DerivingVia #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE ViewPatterns #-} module Language.JavaScript.Inline.Examples.Wasm where import Control.Exception import qualified Data.ByteString.Lazy as LBS import Foreign import Language.JavaScript.Inline import Language.JavaScript.Inline.Examples.Utils newtype I32 = I32 Word32 deriving (Int -> I32 -> ShowS [I32] -> ShowS I32 -> String (Int -> I32 -> ShowS) -> (I32 -> String) -> ([I32] -> ShowS) -> Show I32 forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [I32] -> ShowS $cshowList :: [I32] -> ShowS show :: I32 -> String $cshow :: I32 -> String showsPrec :: Int -> I32 -> ShowS $cshowsPrec :: Int -> I32 -> ShowS Show, Ptr b -> Int -> IO I32 Ptr b -> Int -> I32 -> IO () Ptr I32 -> IO I32 Ptr I32 -> Int -> IO I32 Ptr I32 -> Int -> I32 -> IO () Ptr I32 -> I32 -> IO () I32 -> Int (I32 -> Int) -> (I32 -> Int) -> (Ptr I32 -> Int -> IO I32) -> (Ptr I32 -> Int -> I32 -> IO ()) -> (forall b. Ptr b -> Int -> IO I32) -> (forall b. Ptr b -> Int -> I32 -> IO ()) -> (Ptr I32 -> IO I32) -> (Ptr I32 -> I32 -> IO ()) -> Storable I32 forall b. Ptr b -> Int -> IO I32 forall b. Ptr b -> Int -> I32 -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a poke :: Ptr I32 -> I32 -> IO () $cpoke :: Ptr I32 -> I32 -> IO () peek :: Ptr I32 -> IO I32 $cpeek :: Ptr I32 -> IO I32 pokeByteOff :: Ptr b -> Int -> I32 -> IO () $cpokeByteOff :: forall b. Ptr b -> Int -> I32 -> IO () peekByteOff :: Ptr b -> Int -> IO I32 $cpeekByteOff :: forall b. Ptr b -> Int -> IO I32 pokeElemOff :: Ptr I32 -> Int -> I32 -> IO () $cpokeElemOff :: Ptr I32 -> Int -> I32 -> IO () peekElemOff :: Ptr I32 -> Int -> IO I32 $cpeekElemOff :: Ptr I32 -> Int -> IO I32 alignment :: I32 -> Int $calignment :: I32 -> Int sizeOf :: I32 -> Int $csizeOf :: I32 -> Int Storable) via Word32 newtype I64 = I64 Word64 deriving (Int -> I64 -> ShowS [I64] -> ShowS I64 -> String (Int -> I64 -> ShowS) -> (I64 -> String) -> ([I64] -> ShowS) -> Show I64 forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [I64] -> ShowS $cshowList :: [I64] -> ShowS show :: I64 -> String $cshow :: I64 -> String showsPrec :: Int -> I64 -> ShowS $cshowsPrec :: Int -> I64 -> ShowS Show, Ptr b -> Int -> IO I64 Ptr b -> Int -> I64 -> IO () Ptr I64 -> IO I64 Ptr I64 -> Int -> IO I64 Ptr I64 -> Int -> I64 -> IO () Ptr I64 -> I64 -> IO () I64 -> Int (I64 -> Int) -> (I64 -> Int) -> (Ptr I64 -> Int -> IO I64) -> (Ptr I64 -> Int -> I64 -> IO ()) -> (forall b. Ptr b -> Int -> IO I64) -> (forall b. Ptr b -> Int -> I64 -> IO ()) -> (Ptr I64 -> IO I64) -> (Ptr I64 -> I64 -> IO ()) -> Storable I64 forall b. Ptr b -> Int -> IO I64 forall b. Ptr b -> Int -> I64 -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a poke :: Ptr I64 -> I64 -> IO () $cpoke :: Ptr I64 -> I64 -> IO () peek :: Ptr I64 -> IO I64 $cpeek :: Ptr I64 -> IO I64 pokeByteOff :: Ptr b -> Int -> I64 -> IO () $cpokeByteOff :: forall b. Ptr b -> Int -> I64 -> IO () peekByteOff :: Ptr b -> Int -> IO I64 $cpeekByteOff :: forall b. Ptr b -> Int -> IO I64 pokeElemOff :: Ptr I64 -> Int -> I64 -> IO () $cpokeElemOff :: Ptr I64 -> Int -> I64 -> IO () peekElemOff :: Ptr I64 -> Int -> IO I64 $cpeekElemOff :: Ptr I64 -> Int -> IO I64 alignment :: I64 -> Int $calignment :: I64 -> Int sizeOf :: I64 -> Int $csizeOf :: I64 -> Int Storable) via Word64 newtype F32 = F32 Float deriving (Int -> F32 -> ShowS [F32] -> ShowS F32 -> String (Int -> F32 -> ShowS) -> (F32 -> String) -> ([F32] -> ShowS) -> Show F32 forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [F32] -> ShowS $cshowList :: [F32] -> ShowS show :: F32 -> String $cshow :: F32 -> String showsPrec :: Int -> F32 -> ShowS $cshowsPrec :: Int -> F32 -> ShowS Show, Ptr b -> Int -> IO F32 Ptr b -> Int -> F32 -> IO () Ptr F32 -> IO F32 Ptr F32 -> Int -> IO F32 Ptr F32 -> Int -> F32 -> IO () Ptr F32 -> F32 -> IO () F32 -> Int (F32 -> Int) -> (F32 -> Int) -> (Ptr F32 -> Int -> IO F32) -> (Ptr F32 -> Int -> F32 -> IO ()) -> (forall b. Ptr b -> Int -> IO F32) -> (forall b. Ptr b -> Int -> F32 -> IO ()) -> (Ptr F32 -> IO F32) -> (Ptr F32 -> F32 -> IO ()) -> Storable F32 forall b. Ptr b -> Int -> IO F32 forall b. Ptr b -> Int -> F32 -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a poke :: Ptr F32 -> F32 -> IO () $cpoke :: Ptr F32 -> F32 -> IO () peek :: Ptr F32 -> IO F32 $cpeek :: Ptr F32 -> IO F32 pokeByteOff :: Ptr b -> Int -> F32 -> IO () $cpokeByteOff :: forall b. Ptr b -> Int -> F32 -> IO () peekByteOff :: Ptr b -> Int -> IO F32 $cpeekByteOff :: forall b. Ptr b -> Int -> IO F32 pokeElemOff :: Ptr F32 -> Int -> F32 -> IO () $cpokeElemOff :: Ptr F32 -> Int -> F32 -> IO () peekElemOff :: Ptr F32 -> Int -> IO F32 $cpeekElemOff :: Ptr F32 -> Int -> IO F32 alignment :: F32 -> Int $calignment :: F32 -> Int sizeOf :: F32 -> Int $csizeOf :: F32 -> Int Storable) via Float newtype F64 = F64 Double deriving (Int -> F64 -> ShowS [F64] -> ShowS F64 -> String (Int -> F64 -> ShowS) -> (F64 -> String) -> ([F64] -> ShowS) -> Show F64 forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [F64] -> ShowS $cshowList :: [F64] -> ShowS show :: F64 -> String $cshow :: F64 -> String showsPrec :: Int -> F64 -> ShowS $cshowsPrec :: Int -> F64 -> ShowS Show, Ptr b -> Int -> IO F64 Ptr b -> Int -> F64 -> IO () Ptr F64 -> IO F64 Ptr F64 -> Int -> IO F64 Ptr F64 -> Int -> F64 -> IO () Ptr F64 -> F64 -> IO () F64 -> Int (F64 -> Int) -> (F64 -> Int) -> (Ptr F64 -> Int -> IO F64) -> (Ptr F64 -> Int -> F64 -> IO ()) -> (forall b. Ptr b -> Int -> IO F64) -> (forall b. Ptr b -> Int -> F64 -> IO ()) -> (Ptr F64 -> IO F64) -> (Ptr F64 -> F64 -> IO ()) -> Storable F64 forall b. Ptr b -> Int -> IO F64 forall b. Ptr b -> Int -> F64 -> IO () forall a. (a -> Int) -> (a -> Int) -> (Ptr a -> Int -> IO a) -> (Ptr a -> Int -> a -> IO ()) -> (forall b. Ptr b -> Int -> IO a) -> (forall b. Ptr b -> Int -> a -> IO ()) -> (Ptr a -> IO a) -> (Ptr a -> a -> IO ()) -> Storable a poke :: Ptr F64 -> F64 -> IO () $cpoke :: Ptr F64 -> F64 -> IO () peek :: Ptr F64 -> IO F64 $cpeek :: Ptr F64 -> IO F64 pokeByteOff :: Ptr b -> Int -> F64 -> IO () $cpokeByteOff :: forall b. Ptr b -> Int -> F64 -> IO () peekByteOff :: Ptr b -> Int -> IO F64 $cpeekByteOff :: forall b. Ptr b -> Int -> IO F64 pokeElemOff :: Ptr F64 -> Int -> F64 -> IO () $cpokeElemOff :: Ptr F64 -> Int -> F64 -> IO () peekElemOff :: Ptr F64 -> Int -> IO F64 $cpeekElemOff :: Ptr F64 -> Int -> IO F64 alignment :: F64 -> Int $calignment :: F64 -> Int sizeOf :: F64 -> Int $csizeOf :: F64 -> Int Storable) via Double instance ToJS I32 where toJS :: I32 -> JSExpr toJS I32 x = [js| $buf.readUInt32LE() |] where buf :: ByteString buf = I32 -> ByteString forall a. Storable a => a -> ByteString storableToLBS I32 x instance FromJS I32 where rawJSType :: Proxy I32 -> RawJSType rawJSType Proxy I32 _ = RawJSType RawBuffer toRawJSType :: Proxy I32 -> JSExpr toRawJSType Proxy I32 _ = [js| x => { const buf = Buffer.allocUnsafe(4); buf.writeUInt32LE(x); return buf; } |] fromJS :: Session -> ByteString -> IO I32 fromJS Session _ = ByteString -> IO I32 forall a. Storable a => ByteString -> IO a storableFromLBS instance ToJS I64 where toJS :: I64 -> JSExpr toJS I64 x = [js| $buf.readBigUInt64LE() |] where buf :: ByteString buf = I64 -> ByteString forall a. Storable a => a -> ByteString storableToLBS I64 x instance FromJS I64 where rawJSType :: Proxy I64 -> RawJSType rawJSType Proxy I64 _ = RawJSType RawBuffer toRawJSType :: Proxy I64 -> JSExpr toRawJSType Proxy I64 _ = [js| x => { const buf = Buffer.allocUnsafe(8); buf.writeBigUInt64LE(x); return buf; } |] fromJS :: Session -> ByteString -> IO I64 fromJS Session _ = ByteString -> IO I64 forall a. Storable a => ByteString -> IO a storableFromLBS instance ToJS F32 where toJS :: F32 -> JSExpr toJS F32 x = [js| $buf.readFloatLE() |] where buf :: ByteString buf = F32 -> ByteString forall a. Storable a => a -> ByteString storableToLBS F32 x instance FromJS F32 where rawJSType :: Proxy F32 -> RawJSType rawJSType Proxy F32 _ = RawJSType RawBuffer toRawJSType :: Proxy F32 -> JSExpr toRawJSType Proxy F32 _ = [js| x => { const buf = Buffer.allocUnsafe(4); buf.writeFloatLE(x); return buf; } |] fromJS :: Session -> ByteString -> IO F32 fromJS Session _ = ByteString -> IO F32 forall a. Storable a => ByteString -> IO a storableFromLBS instance ToJS F64 where toJS :: F64 -> JSExpr toJS F64 x = [js| $buf.readDoubleLE() |] where buf :: ByteString buf = F64 -> ByteString forall a. Storable a => a -> ByteString storableToLBS F64 x instance FromJS F64 where rawJSType :: Proxy F64 -> RawJSType rawJSType Proxy F64 _ = RawJSType RawBuffer toRawJSType :: Proxy F64 -> JSExpr toRawJSType Proxy F64 _ = [js| x => { const buf = Buffer.allocUnsafe(8); buf.writeDoubleLE(x); return buf; } |] fromJS :: Session -> ByteString -> IO F64 fromJS Session _ = ByteString -> IO F64 forall a. Storable a => ByteString -> IO a storableFromLBS importNew :: Session -> IO JSVal importNew :: Session -> IO JSVal importNew Session _session = Session -> JSExpr -> IO JSVal forall a. FromJS a => Session -> JSExpr -> IO a eval Session _session [js| {} |] importAdd :: Export f => Session -> JSVal -> String -> String -> f -> IO () importAdd :: Session -> JSVal -> String -> String -> f -> IO () importAdd Session _session JSVal _import_obj (String -> Aeson String forall a. a -> Aeson a Aeson -> Aeson String _import_module) (String -> Aeson String forall a. a -> Aeson a Aeson -> Aeson String _import_name) f _import_hs_func = do JSVal _import_js_func <- Session -> f -> IO JSVal forall f. Export f => Session -> f -> IO JSVal exportSync Session _session f _import_hs_func () -> IO () forall a. a -> IO a evaluate (() -> IO ()) -> IO () -> IO () forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Session -> JSExpr -> IO () forall a. FromJS a => Session -> JSExpr -> IO a eval Session _session [js| if (!($_import_obj[$_import_module])) { $_import_obj[$_import_module] = {}; } $_import_obj[$_import_module][$_import_name] = $_import_js_func; |] wasmCompile :: Session -> LBS.ByteString -> IO JSVal wasmCompile :: Session -> ByteString -> IO JSVal wasmCompile Session _session ByteString _module_buf = Session -> JSExpr -> IO JSVal forall a. FromJS a => Session -> JSExpr -> IO a eval Session _session [js| WebAssembly.compile($_module_buf) |] wasmInstantiate :: Session -> JSVal -> JSVal -> IO JSVal wasmInstantiate :: Session -> JSVal -> JSVal -> IO JSVal wasmInstantiate Session _session JSVal _module JSVal _import_obj = Session -> JSExpr -> IO JSVal forall a. FromJS a => Session -> JSExpr -> IO a eval Session _session [js| WebAssembly.instantiate($_module, $_import_obj) |] exportGet :: Import f => Session -> JSVal -> String -> IO f exportGet :: Session -> JSVal -> String -> IO f exportGet Session _session JSVal _instance (String -> Aeson String forall a. a -> Aeson a Aeson -> Aeson String _export_name) = do JSVal _export_js_func <- Session -> JSExpr -> IO JSVal forall a. FromJS a => Session -> JSExpr -> IO a eval Session _session [js| $_instance.exports[$_export_name] |] f -> IO f forall (f :: * -> *) a. Applicative f => a -> f a pure (f -> IO f) -> f -> IO f forall a b. (a -> b) -> a -> b $ Session -> JSVal -> f forall f. Import f => Session -> JSVal -> f importJSFunc Session _session JSVal _export_js_func