Better coercions for CustomEvent, no F-read

Author: garyb

bower.json

@@ -1,10 +1,10 @@
 {
-  "name": "purescript-web-dom",
-  "homepage": "https://github.com/purescript-web/purescript-web-dom",
+  "name": "purescript-web-events",
+  "homepage": "https://github.com/purescript-web/purescript-web-events",
   "license": "MIT",
   "repository": {
     "type": "git",
-    "url": "git://github.com/purescript-web/purescript-web-dom.git"
+    "url": "git://github.com/purescript-web/purescript-web-events.git"
   },
   "ignore": [
     "**/.*",
@@ -17,7 +17,6 @@
   "dependencies": {
     "purescript-datetime": "#compiler/0.12",
     "purescript-enums": "#compiler/0.12",
-    "purescript-foreign": "#compiler/0.12",
     "purescript-nullable": "#compiler/0.12"
   }
 }

src/Web/Event/CustomEvent.purs

@@ -1,13 +1,14 @@
 module Web.Event.CustomEvent where
 
-import Foreign (F, Foreign, unsafeReadTagged)
+import Data.Maybe (Maybe)
 import Unsafe.Coerce as U
 import Web.Event.Event (Event)
+import Web.Internal.FFI (unsafeReadProtoTagged)
 
 foreign import data CustomEvent :: Type
 
+fromEvent :: Event -> Maybe CustomEvent
+fromEvent = unsafeReadProtoTagged "CustomEvent"
+
 toEvent :: CustomEvent -> Event
 toEvent = U.unsafeCoerce
-
-read :: Foreign -> F CustomEvent
-read = unsafeReadTagged "CustomEvent"

src/Web/Event/Event.purs

@@ -23,8 +23,8 @@ import Data.Newtype (class Newtype)
 import Data.Nullable (Nullable, toMaybe)
 import Effect (Effect)
 import Web.Event.EventPhase (EventPhase)
-import Web.Event.Types (Event) as Exports
-import Web.Event.Types (Event, EventTarget)
+import Web.Event.Internal.Types (Event) as Exports
+import Web.Event.Internal.Types (Event, EventTarget)
 
 -- | The type of strings used for event types.
 newtype EventType = EventType String

src/Web/Event/EventTarget.js

@@ -1,14 +1,5 @@
-/* global EventTarget */
 "use strict";
 
-exports._read = function (left) {
-  return function (right) {
-    return function (foreign) {
-      return foreign instanceof EventTarget ? right(foreign) : left("Value is not an EventTarget");
-    };
-  };
-};
-
 exports.eventListener = function (fn) {
   return function (event) {
     return fn(event);

src/Web/Event/EventTarget.purs

@@ -1,6 +1,5 @@
 module Web.Event.EventTarget
   ( module Exports
-  , read
   , EventListener
   , eventListener
   , addEventListener
@@ -10,23 +9,10 @@ module Web.Event.EventTarget
 
 import Prelude
 
-import Control.Monad.Except (except)
-import Data.Bifunctor (lmap)
-import Data.Either (Either(..))
 import Effect (Effect)
-import Foreign (F, Foreign, ForeignError(..))
 import Web.Event.Event (EventType)
-import Web.Event.Types (Event, EventTarget)
-import Web.Event.Types (EventTarget) as Exports
-
-read :: Foreign -> F EventTarget
-read = except <<< lmap (pure <<< ForeignError) <<< _read Left Right
-
-foreign import _read
-  :: (forall a b. a -> Either a b)
-  -> (forall a b. b -> Either a b)
-  -> Foreign
-  -> Either String EventTarget
+import Web.Event.Internal.Types (Event, EventTarget)
+import Web.Event.Internal.Types (EventTarget) as Exports
 
 -- | A boxed function that can be used as an event listener. This is necessary
 -- | due to the underlying implementation of Effect functions.

src/Web/Event/Types.purs src/Web/Event/Internal/Types.purssrc/Web/Event/Types.purs renamed to src/Web/Event/Internal/Types.purs

@@ -1,4 +1,4 @@
-module Web.Event.Types where
+module Web.Event.Internal.Types where
 
 -- | Basic type for all DOM events.
 foreign import data Event :: Type

src/Web/Internal/FFI.js

@@ -0,0 +1,16 @@
+"use strict";
+
+exports._unsafeReadProtoTagged = function (nothing, just, name, value) {
+  var obj = value;
+  while (obj != null) {
+    var proto = Object.getPrototypeOf(obj);
+    var ctor = proto.constructor.name;
+    if (ctor === name) {
+      return just(value);
+    } else if (ctor === "Object") {
+      return nothing;
+    }
+    obj = proto;
+  }
+  return nothing;
+};

src/Web/Internal/FFI.purs

@@ -0,0 +1,17 @@
+module Web.Internal.FFI (unsafeReadProtoTagged) where
+
+import Data.Function.Uncurried (Fn4, runFn4)
+import Data.Maybe (Maybe(..))
+
+unsafeReadProtoTagged :: forall a b. String -> a -> Maybe b
+unsafeReadProtoTagged name value =
+  runFn4 _unsafeReadProtoTagged Nothing Just name value
+
+foreign import _unsafeReadProtoTagged
+  :: forall a b
+   . Fn4
+      (forall x. Maybe x)
+      (forall x. x -> Maybe x)
+      String
+      a
+      (Maybe b)