Merge pull request #4 from purescript-web/XMLSerializer

implemented XMLSerializer FFI; fixes #3

Author: bbarker

src/Web/DOM/DOMParser.purs

@@ -21,40 +21,40 @@ import Web.DOM.Node (textContent)
 
 foreign import data DOMParser ∷ Type
 
---| Create a new `DOMParser`
+-- | Create a new `DOMParser`
 foreign import makeDOMParser ∷ Effect DOMParser
 
---| Parse a string with the first argumet being a string for a doctype.
---| Does not capture errors; consider using other wrapper functions,
---| e.g. `parseXMLFromString`.
+-- | Parse a string with the first argumet being a string for a doctype.
+-- | Does not capture errors; consider using other wrapper functions,
+-- | e.g. `parseXMLFromString`.
 foreign import parseFromString ∷ String -> String -> DOMParser -> Effect Document
 
---| Convience function to parse HTML from a string, partially applying
---| `parseFromString` with "text/html"
+-- | Convience function to parse HTML from a string, partially applying
+-- | `parseFromString` with "text/html"
 parseHTMLFromString ∷ String -> DOMParser -> Effect (Either String Document)
 parseHTMLFromString s d = do
   doc <- parseFromString "text/html" s d
   errMay <- _getParserError doc
   pure $ returnIfNothing errMay doc
 
---| Convience function to parse SVG from a string, partially applying
---| `parseFromString` with "image/svg+xml"
+-- | Convience function to parse SVG from a string, partially applying
+-- | `parseFromString` with "image/svg+xml"
 parseSVGFromString ∷ String -> DOMParser -> Effect (Either String Document)
 parseSVGFromString s d = do
   doc <- parseFromString "image/svg+xml" s d
   errMay <- _getParserError doc
   pure $ returnIfNothing errMay doc
 
---| Convience function to parse XML from a string, partially applying
---| `parseFromString` with "application/xml"
+-- | Convience function to parse XML from a string, partially applying
+-- | `parseFromString` with "application/xml"
 parseXMLFromString ∷ String -> DOMParser -> Effect (Either String Document)
 parseXMLFromString s d = do
   doc <- parseFromString "application/xml" s d
   errMay <- _getParserError doc
   pure $ returnIfNothing errMay doc
 
---| Utility method for extracting Dom Parser errors from document;
---| should only need to be used if calling `parseFromString` directly.
+-- | Utility method for extracting Dom Parser errors from document;
+-- | should only need to be used if calling `parseFromString` directly.
 _getParserError :: Document -> Effect (Maybe String)
 _getParserError doc = do
   peElems :: Array Element <- join $ map toArray $ getElementsByTagName "parsererror" doc
@@ -66,9 +66,9 @@ _getParserError doc = do
         Nothing -> pure $ Nothing
         Just nd -> map Just $ textContent nd
 
---| Like [Data.Either.note](https://pursuit.purescript.org/packages/purescript-either/docs/Data.Either#v:note),
---| but with the logic reversed. Used internally for converting the
---| result of `_getParserError` to an `Either`.
+-- | Like [Data.Either.note](https://pursuit.purescript.org/packages/purescript-either/docs/Data.Either#v:note),
+-- | but with the logic reversed. Used internally for converting the
+-- | result of `_getParserError` to an `Either`.
 returnIfNothing :: forall a b. Maybe a -> b -> Either a b
 returnIfNothing errMay val = case errMay of
   Nothing -> Right val

src/Web/DOM/XMLSerializer.js

@@ -0,0 +1,14 @@
+/* Web.DOM.XMLSerializer */
+"use strict";
+
+exports.makeXMLSerializer = function () {
+  return new XMLSerializer();
+};
+
+exports.serializeToString =  function (doc) {
+  return function (xmlSerializer) {
+    return function () { // Effect thunk
+      return xmlSerializer.serializeToString(doc);
+    };
+  };
+};

src/Web/DOM/XMLSerializer.purs

@@ -0,0 +1,20 @@
+module Web.DOM.XMLSerializer
+  ( XMLSerializer
+  , makeXMLSerializer
+  , serializeToString
+  ) where
+
+import Effect (Effect)
+import Web.DOM.Document (Document)
+
+foreign import data XMLSerializer ∷ Type
+
+-- | Create a new `XMLSerializer`
+foreign import makeXMLSerializer ∷ Effect XMLSerializer
+
+-- | The `serializeToString(root)` method must [produce an XML
+-- | serialization](https://www.w3.org/TR/DOM-Parsing/#dfn-concept-serialize-xml) of
+-- | `root` passing a value of false for the [require well-formed
+-- | parameter](https://www.w3.org/TR/DOM-Parsing/#dfn-concept-well-formed), and
+-- | return the result.
+foreign import serializeToString ∷ Document -> XMLSerializer -> Effect String

test/Main.purs

@@ -2,15 +2,18 @@ module Test.Main where
 
 import Prelude
 
-import Data.Either (Either, isLeft, isRight)
+import Data.Either (Either, fromRight, isLeft, isRight)
 import Data.Maybe (Maybe(..))
 import Effect (Effect)
 import Effect.Console (log)
+import Partial.Unsafe (unsafePartial)
 import Test.Data as TD
 
 import Web.DOM.Document (Document)
-import Web.DOM.DOMParser (DOMParser, makeDOMParser, parseFromString,
-                          parseXMLFromString, _getParserError)
+import Web.DOM.DOMParser (DOMParser, makeDOMParser, parseFromString
+                         , parseXMLFromString, _getParserError)
+import Web.DOM.XMLSerializer (XMLSerializer, makeXMLSerializer
+                             , serializeToString)
 
 parseNoteDocRaw :: DOMParser -> Effect Document
 parseNoteDocRaw = parseFromString "application/xml" TD.noteXml
@@ -43,5 +46,8 @@ main = do
   log $ "is Right? " <> show (isRight shouldBeRight)
   shouldBeLeft <- parseGarbage domParser
   log $ "is Left? " <> show (isLeft shouldBeLeft)
+  xmlSrlzr <- makeXMLSerializer
+  strFromNote <- unsafePartial $ serializeToString (fromRight shouldBeRight) xmlSrlzr
+  log $ "serialization of note is:\n" <> strFromNote
 
   log "TODO: You should add some tests."