Merge pull request #76 from purescript-contrib/read-nodes

Add `read*` functions for `Node`, `Document`, `Element`

Author: garyb

src/DOM/Node/Types.purs

@@ -2,12 +2,20 @@
 module DOM.Node.Types where
 
 import Prelude
+
+import Data.Foreign (F, Foreign)
 import Data.Newtype (class Newtype)
+
 import DOM.Event.Types (EventTarget)
+
 import Unsafe.Coerce (unsafeCoerce)
+import DOM.Util.FFI (unsafeReadProtoTagged)
 
 foreign import data Node :: *
 
+readNode :: Foreign -> F Node
+readNode = unsafeReadProtoTagged "Node"
+
 foreign import data NonElementParentNode :: *
 foreign import data ParentNode :: *
 foreign import data NonDocumentTypeChildNode :: *
@@ -18,6 +26,9 @@ foreign import data DOMTokenList :: *
 
 foreign import data Document :: *
 
+readDocument :: Foreign -> F Document
+readDocument = unsafeReadProtoTagged "Document"
+
 documentToNonElementParentNode :: Document -> NonElementParentNode
 documentToNonElementParentNode = unsafeCoerce
 
@@ -38,6 +49,9 @@ derive instance newtypeElementId :: Newtype ElementId _
 derive newtype instance eqElementId :: Eq ElementId
 derive newtype instance oOrdElementId :: Ord ElementId
 
+readElement :: Foreign -> F Element
+readElement = unsafeReadProtoTagged "Element"
+
 elementToParentNode :: Element -> ParentNode
 elementToParentNode = unsafeCoerce
 

src/DOM/Util/FFI.js

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

src/DOM/Util/FFI.purs

@@ -0,0 +1,23 @@
+module DOM.Util.FFI (unsafeReadProtoTagged) where
+
+import Prelude
+
+import Control.Monad.Except (except)
+
+import Data.Either (Either(..))
+import Data.Foreign (F, Foreign, ForeignError(..))
+
+foreign import _unsafeReadProtoTagged
+  :: forall n
+   . String
+  -> (forall a. String -> F a)
+  -> (forall a. a -> F a)
+  -> Foreign
+  -> F n
+
+unsafeReadProtoTagged :: forall a. String -> Foreign -> F a
+unsafeReadProtoTagged name =
+  _unsafeReadProtoTagged
+    name
+    (except <<< Left <<< pure <<< TypeMismatch name)
+    (except <<< Right)