first commit

Author: gbagan

.gitignore

@@ -0,0 +1,8 @@
+/.*
+!/.gitignore
+!/.eslintrc.json
+!/.github/
+package-lock.json
+/bower_components/
+/node_modules/
+/output/

bower.json

@@ -0,0 +1,21 @@
+{
+    "name": "purescript-web-workers",
+    "license": [
+        "MIT"
+    ],
+    "repository": {
+        "type": "git",
+        "url": "https://github.com/gbagan/purescript-web-workers"
+    },
+    "ignore": [
+        "**/.*",
+        "node_modules",
+        "bower_components",
+        "output"
+    ],
+    "dependencies": {
+        "purescript-effect": "^v4.0.0",
+        "purescript-maybe": "^v6.0.0",
+        "purescript-prelude": "^v6.0.0"
+    }
+}

package.json

@@ -0,0 +1,14 @@
+{
+    "private": true,
+    "scripts": {
+        "clean": "rimraf output && rimraf .pulp-cache",
+        "build": "eslint src && pulp build -- --censor-lib --strict"
+    },
+    "devDependencies": {
+        "eslint": "^8.15.0",
+        "pulp": "^16.0.1",
+        "purescript-psa": "^0.8.2",
+        "rimraf": "^3.0.2",
+        "spago": "^0.20.9"
+    }
+}

spago.dhall

@@ -0,0 +1,7 @@
+{ name = "web-workers"
+, license = "MIT"
+, repository = "https://github.com/gbagan/purescript-web-workers"
+, dependencies = ["prelude", "effect", "maybe"]
+, packages = ./packages.dhall
+, sources = [ "src/**/*.purs" ]
+}

src/Web/Worker/Event.js

@@ -0,0 +1,11 @@
+export function data_(ev) {
+  return ev.data; 
+}
+
+export function origin(ev) {
+  return ev.origin; 
+}
+
+export function lastEventId(ev) {
+  return ev.lastEventId;
+}

src/Web/Worker/Event.purs

@@ -0,0 +1,14 @@
+module Web.Worker.Event where
+
+import Foreign (Foreign)
+
+foreign import data MessageEvent :: Type
+
+foreign import data_ :: MessageEvent -> Foreign
+
+foreign import origin :: MessageEvent -> String
+
+foreign import lastEventId :: MessageEvent -> String
+
+-- source :: WindwProxy | MessagePort | ServiceWorker
+-- ports :: Array MessagePort

src/Web/Worker/Worker.js

@@ -0,0 +1,39 @@
+export function newImpl (src) {
+  return function (opts) {
+    return function () {
+      return new Worker(src, opts);
+    };
+  };
+}
+
+export function postMessage(data) {
+  return function (transfer) {
+    return function (worker) {
+      return function () {
+        worker.postMessage(data, transfer.length > 0 ? transfer : undefined);
+      };
+    };
+  };
+}
+
+export function terminate (worker) {
+  return function () {
+    worker.terminate();
+  };
+}
+
+export function onMessage(f) {
+  return function (worker) {
+    return function () {
+      worker.onmessage = f;
+    };
+  };
+}
+
+export function onError(f) {
+  return function (worker) {
+    return function () {
+      worker.onerror = f;
+    };
+  };
+}

src/Web/Worker/Worker.purs

@@ -0,0 +1,81 @@
+module Web.Worker.Worker
+  ( Worker
+  , WorkerType
+  , Credentials
+  , WorkerOptions
+  , fromEventTarget
+  , toEventTarget
+  , new
+  , defaultWorkerOptions
+  , postMessage
+  , onError
+  , onMessage
+  , terminate
+  )
+  where
+
+import Prelude
+import Data.Maybe (Maybe)
+import Effect (Effect)
+import Unsafe.Coerce (unsafeCoerce)
+import Web.Event.Event (Event)
+import Web.Event.EventTarget (EventTarget)
+import Web.Internal.FFI (unsafeReadProtoTagged)
+import Web.Worker.Event (MessageEvent)
+
+
+foreign import data Worker :: Type
+
+
+fromEventTarget :: EventTarget -> Maybe Worker
+fromEventTarget = unsafeReadProtoTagged "Worker"
+
+toEventTarget :: Worker -> EventTarget
+toEventTarget = unsafeCoerce
+
+data WorkerType = Classic | Module
+data Credentials = Omit | SameOrigin | Include
+
+type WorkerOptions =
+  { credentials :: Credentials
+  , name :: String
+  , type :: WorkerType 
+  }
+
+defaultWorkerOptions :: WorkerOptions
+defaultWorkerOptions =
+  { name: ""
+  , credentials: Omit
+  , type: Classic
+  }
+
+--foreign import onError :: (Error -> Effect Unit) -> Worker -> Effect Unit
+
+foreign import newImpl :: String -> { name :: String, credentials :: String, type :: String } -> Effect Worker
+
+new :: String -> WorkerOptions -> Effect Worker
+new url {name, type: t, credentials} = newImpl url
+    { name
+    , credentials: show credentials
+    , type: show t
+    }
+
+
+foreign import postMessage :: forall msg tr. msg -> Array tr -> Worker -> Effect Unit
+
+foreign import terminate :: Worker -> Effect Unit
+
+foreign import onMessage :: (MessageEvent -> Effect Unit) -> Worker -> Effect Unit
+
+foreign import onError :: (Event -> Effect Unit) -> Worker -> Effect Unit
+
+instance Show WorkerType where
+  show = case _ of
+    Classic -> "classic"
+    Module  -> "module"
+
+instance Show Credentials where
+  show = case _ of
+    Omit       -> "omit"
+    SameOrigin -> "same-origin"
+    Include    -> "include"