{-# 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