Add the typeclass IsSendable

CHANGELOG.md

@@ -5,6 +5,7 @@ Notable changes to this project are documented in this file. The format is based
 ## [Unreleased]
 
 Breaking changes:
+- The data argument of functions `postMessage` and `postMessage'` must be instance of a new typeclass `IsSendable`  
 - Refactored `Worker` to better match the spec
 - Refactored `Credentials`' `Show` instance to be more `Show`-like; use `printCredentials` now
 

package.json

@@ -2,7 +2,7 @@
     "private": true,
     "scripts": {
         "clean": "rimraf output && rimraf .pulp-cache",
-        "build": "eslint src && pulp build -- --censor-lib --strict"
+        "build": "eslint src && spago build"
     },
     "devDependencies": {
         "eslint": "^8.15.0",

spago.dhall

@@ -4,6 +4,7 @@
   , "foreign"
   , "functions"
   , "maybe"
+  , "newtype"
   , "prelude"
   , "unsafe-coerce"
   , "web-events"

src/Web/Worker/DedicatedWorkerGlobalScope.purs

@@ -14,15 +14,15 @@ import Effect (Effect)
 import Effect.Uncurried (EffectFn1, EffectFn2, mkEffectFn1, runEffectFn1, runEffectFn2)
 import Web.Worker.GlobalScope (importScripts, location, navigator, onError, onLanguageChange, onOffline, onOnline, onRejectionHandled, onUnhandledRejection) as GlobalScope
 import Web.Worker.MessageEvent (MessageEvent)
-import Web.Worker.Types (Transferable)
+import Web.Worker.Types (class IsSendable, Transferable)
 
 foreign import name :: Effect String
 
 -- | sends a message to the main thread that spawned it.
-postMessage :: forall msg. msg -> Effect Unit
+postMessage :: forall msg. IsSendable msg => msg -> Effect Unit
 postMessage msg = postMessage' msg []
 
-postMessage' :: forall msg. msg -> Array Transferable -> Effect Unit
+postMessage' :: forall msg. IsSendable msg => msg -> Array Transferable -> Effect Unit
 postMessage' msg tr = runEffectFn2 postMessageImpl msg tr
 
 foreign import postMessageImpl :: forall msg. EffectFn2 msg (Array Transferable) Unit

src/Web/Worker/MessagePort.purs

@@ -12,7 +12,7 @@ import Prelude
 
 import Effect (Effect)
 import Effect.Uncurried (EffectFn1, EffectFn2, EffectFn3, mkEffectFn1, runEffectFn1, runEffectFn2, runEffectFn3)
-import Web.Worker.Types (MessageEvent, MessagePort, Transferable)
+import Web.Worker.Types (class IsSendable, MessageEvent, MessagePort, Transferable)
 import Web.Worker.Types (MessagePort) as Types
 
 onMessage :: (MessageEvent -> Effect Unit) -> MessagePort -> Effect Unit
@@ -27,10 +27,10 @@ foreign import onMessageErrorImpl :: EffectFn2 MessagePort (EffectFn1 MessageEve
 
 foreign import postMessageImpl :: forall msg. EffectFn3 MessagePort msg (Array Transferable) Unit
 
-postMessage :: forall msg. msg -> MessagePort -> Effect Unit
+postMessage :: forall msg. IsSendable msg => msg -> MessagePort -> Effect Unit
 postMessage msg port = postMessage' msg [] port
 
-postMessage' :: forall msg. msg -> Array Transferable -> MessagePort -> Effect Unit
+postMessage' :: forall msg. IsSendable msg => msg -> Array Transferable -> MessagePort -> Effect Unit
 postMessage' msg data_ port = runEffectFn3 postMessageImpl port msg data_
 
 close :: MessagePort -> Effect Unit

src/Web/Worker/Types.purs

@@ -1,5 +1,51 @@
-module Web.Worker.Types where
+module Web.Worker.Types
+  ( MessageEvent
+  , MessagePort
+  , Transferable
+  , SendWrapper
+  , class IsSendable
+  , wrap
+  , unwrap
+  , unsafeWrap
+  ) where
+
+import Prelude
+
+import Prim.RowList (class RowToList, RowList)
+import Prim.RowList as Row
+import Data.Newtype (class Newtype)
 
 foreign import data Transferable :: Type
 foreign import data MessagePort :: Type
 foreign import data MessageEvent :: Type
+
+class IsSendable (a :: Type)
+
+instance IsSendable Boolean
+instance IsSendable Int
+instance IsSendable Number
+instance IsSendable Char
+instance IsSendable String
+instance IsSendable a => IsSendable (Array a)
+instance (RowToList r rl, IsSendableRowList rl) => IsSendable (Record r)
+instance IsSendable Unit
+instance IsSendable Void
+instance IsSendable (SendWrapper a)
+
+class IsSendableRowList (rl :: RowList Type)
+
+instance IsSendableRowList Row.Nil
+instance (IsSendable a, IsSendableRowList rest) => IsSendableRowList (Row.Cons sym a rest)
+
+newtype SendWrapper a = SendWrapper a
+
+wrap :: forall a b. Newtype a b => IsSendable b => a -> SendWrapper a
+wrap = SendWrapper
+
+unwrap :: forall a. SendWrapper a -> a
+unwrap (SendWrapper a) = a
+
+-- | Use with care. If you send something that isn't actually Sendable, it
+-- | will raise an exception.
+unsafeWrap :: forall a. a -> SendWrapper a
+unsafeWrap = SendWrapper

src/Web/Worker/Worker.purs

@@ -25,7 +25,7 @@ import Web.Internal.FFI (unsafeReadProtoTagged)
 import Web.Worker.MessageEvent (MessageEvent)
 import Web.Worker.Options (WorkerOptions, Credentials(..), WorkerType(..), defaultWorkerOptions) as Options
 import Web.Worker.Options (WorkerOptions, toJsOptions)
-import Web.Worker.Types (Transferable)
+import Web.Worker.Types (class IsSendable, Transferable)
 
 foreign import data Worker :: Type
 
@@ -44,10 +44,10 @@ new url options = runEffectFn2 newImpl url (toJsOptions options)
 foreign import postMessageImpl :: forall msg. EffectFn3 Worker msg (Array Transferable) Unit
 
 -- | sends a message to the worker's inner scope. 
-postMessage :: forall msg. msg -> Worker -> Effect Unit
+postMessage :: forall msg. IsSendable msg => msg -> Worker -> Effect Unit
 postMessage msg worker = postMessage' msg [] worker
 
-postMessage' :: forall msg. msg -> Array Transferable -> Worker -> Effect Unit
+postMessage' :: forall msg. IsSendable msg => msg -> Array Transferable -> Worker -> Effect Unit
 postMessage' msg tr worker = runEffectFn3 postMessageImpl worker msg tr
 
 -- | immediately terminates the worker.