WIP

Author: garyb

bower.json

@@ -0,0 +1,17 @@
+{
+  "name": "purescript-halogen-vdom-string-renderer",
+  "ignore": [
+    "**/.*",
+    "node_modules",
+    "bower_components",
+    "output"
+  ],
+  "dependencies": {
+    "purescript-prelude": "^2.3.0",
+    "purescript-console": "^2.0.0",
+    "purescript-halogen-vdom": "^1.0.1"
+  },
+  "devDependencies": {
+    "purescript-psci-support": "^2.0.0"
+  }
+}

src/Halogen/VDom/DOM/StringRenderer.purs

@@ -0,0 +1,48 @@
+module Halogen.VDom.DOM.StringRenderer where
+
+import Prelude
+import Halogen.VDom (VDom(..), ElemSpec(..), ElemName(..), Namespace(..), runGraft)
+import Halogen.VDom.DOM.Prop (Prop(..))
+import Data.Tuple (snd)
+import Data.String as S
+import Data.Maybe (maybe)
+import Data.Array as A
+import Data.Foldable as F
+import Halogen.VDom.StringRenderer as VSR
+
+
+render ∷ ∀ i w. (w → String) → VDom (Array (Prop i)) w → String
+render renderWidget = VSR.render getTagType renderProps renderWidget
+  where
+  getTagType :: ElemName -> VSR.TagType
+  getTagType en
+    | F.elem en voidElements = VSR.SelfClosingTag
+    | otherwise = VSR.NormalTag
+  renderProps :: Array (Prop i) -> String
+  renderProps = S.joinWith " " <<< A.mapMaybe renderProp
+  renderProp :: Prop i -> Maybe String
+  renderProp = case _ of
+    Attribute (Maybe Namespace) String String
+    Property String PropValue
+    Handler _ _ → Nothing
+    Ref _ → Nothing
+
+voidElements :: Array ElemName
+voidElements =
+  [ ElemName "area"
+  , ElemName "base"
+  , ElemName "br"
+  , ElemName "col"
+  , ElemName "embed"
+  , ElemName "hr"
+  , ElemName "img"
+  , ElemName "input"
+  , ElemName "isindex" -- legacy XHTML
+  , ElemName "keygen"
+  , ElemName "link"
+  , ElemName "meta"
+  , ElemName "param"
+  , ElemName "source"
+  , ElemName "track"
+  , ElemName "wbr"
+  ]

src/Halogen/VDom/StringRenderer.purs

@@ -0,0 +1,48 @@
+module Halogen.VDom.StringRenderer where
+
+import Prelude
+
+import Data.Array as A
+import Data.Maybe (maybe)
+import Data.String as S
+import Data.Tuple (snd)
+
+import Halogen.VDom (VDom(..), ElemSpec(..), ElemName(..), Namespace(..), runGraft)
+
+-- | Type used to determine whether an element can be rendered as self-closing
+-- | element, for example, "<br/>".
+data TagType
+  = NormalTag
+  | SelfClosingTag
+
+derive instance eqTagType ∷ Eq TagType
+derive instance ordTagType ∷ Ord TagType
+
+-- | Renders a `VDom` tree to a string using the specified tag type scheme,
+-- | attribute renderer, and widget renderer.
+render
+  ∷ ∀ a w
+  . (ElemName → TagType)
+  → (a → String)
+  → (w → String)
+  → VDom a w
+  → String
+render getTagType renderAttrs renderWidget = go
+  where
+  go ∷ VDom a w → String
+  go = case _ of
+    Text s → s
+    Elem elem children → renderElement elem children
+    Keyed elem kchildren → renderElement elem (map snd kchildren)
+    Widget w → renderWidget w
+    Grafted g → go (runGraft g)
+  renderElement ∷ ElemSpec a → Array (VDom a w) → String
+  renderElement (ElemSpec mns en@(ElemName name) attrs) children =
+    let
+      as = renderAttrs attrs
+      as' = maybe as (\(Namespace ns) -> "xmlns=\"" <> ns <> "\"" <> if S.null as then "" else " " <> as) mns
+    in
+      "<" <> name <> if S.null as then "" else " " <> as <>
+        if A.null children
+        then if getTagType en == SelfClosingTag then "/>" else "</" <> name <> ">"
+        else ">" <> S.joinWith "" (map go children) <> "</" <> name <> ">"