├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── elm-package.json ├── src └── ElmHtml │ ├── Constants.elm │ ├── Helpers.elm │ ├── InternalTypes.elm │ ├── Markdown.elm │ ├── ToElmString.elm │ ├── ToHtml.elm │ └── ToString.elm └── tests ├── Native └── HtmlAsJson.js ├── Tests.elm └── elm-package.json /.gitignore: -------------------------------------------------------------------------------- 1 | # elm-package generated files 2 | elm-stuff/ 3 | # elm-repl generated files 4 | repl-temp-* 5 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | sudo: false 2 | 3 | cache: 4 | directories: 5 | - tests/elm-stuff/build-artifacts 6 | 7 | os: 8 | - osx 9 | - linux 10 | 11 | env: 12 | matrix: 13 | - ELM_VERSION=0.18 TARGET_NODE_VERSION=node 14 | - ELM_VERSION=0.18 TARGET_NODE_VERSION=4.2 15 | 16 | before_install: 17 | - if [ ${TRAVIS_OS_NAME} == "osx" ]; 18 | then brew update; brew install nvm; mkdir ~/.nvm; export NVM_DIR=~/.nvm; source $(brew --prefix nvm)/nvm.sh; 19 | fi 20 | 21 | install: 22 | - nvm install $TARGET_NODE_VERSION 23 | - nvm use $TARGET_NODE_VERSION 24 | - node --version 25 | - npm --version 26 | - npm install -g elm@$ELM_VERSION 27 | - npm install -g elm-test 28 | 29 | 30 | script: 31 | - elm-test 32 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright (c) 2016, Noah 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | * Neither the name of the copyright holder nor the names of its 17 | contributors may be used to endorse or promote products derived from 18 | this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 21 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 22 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 24 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 26 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 27 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 28 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 29 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 30 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # elm-html-in-elm 2 | 3 | 4 | A pure Elm represention of Elm Html. This module has been taken from [elm-server-side-renderer](https://github.com/eeue56/elm-server-side-renderer) and is a pure representation of the Html structure used by VirtualDom. It is designed to allow you to inspect Html nodes 5 | 6 | This package is used to support testing with [elm-html-test](http://package.elm-lang.org/packages/eeue56/elm-html-test/latest). 7 | 8 | This package is also used to support using Elm as to generate static files for 9 | your site with [elm-static-html](https://github.com/eeue56/elm-static-html) 10 | -------------------------------------------------------------------------------- /elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "5.2.0", 3 | "summary": "A pure Elm representation of Elm Html", 4 | "repository": "https://github.com/eeue56/elm-html-in-elm.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "src" 8 | ], 9 | "exposed-modules": [ 10 | "ElmHtml.Constants", 11 | "ElmHtml.InternalTypes", 12 | "ElmHtml.Markdown", 13 | "ElmHtml.ToString", 14 | "ElmHtml.ToElmString", 15 | "ElmHtml.ToHtml" 16 | ], 17 | "dependencies": { 18 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 19 | "elm-lang/html": "2.0.0 <= v < 3.0.0" 20 | }, 21 | "elm-version": "0.18.0 <= v < 0.19.0" 22 | } 23 | -------------------------------------------------------------------------------- /src/ElmHtml/Constants.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.Constants exposing (..) 2 | 3 | {-| 4 | Constants for representing internal keys for Elm's vdom implementation 5 | 6 | @docs styleKey, eventKey, attributeKey, attributeNamespaceKey, knownKeys 7 | 8 | -} 9 | 10 | 11 | {-| Internal key for style 12 | -} 13 | styleKey : String 14 | styleKey = 15 | "STYLE" 16 | 17 | 18 | {-| Internal key for style 19 | -} 20 | eventKey : String 21 | eventKey = 22 | "EVENT" 23 | 24 | 25 | {-| Internal key for style 26 | -} 27 | attributeKey : String 28 | attributeKey = 29 | "ATTR" 30 | 31 | 32 | {-| Internal key for style 33 | -} 34 | attributeNamespaceKey : String 35 | attributeNamespaceKey = 36 | "ATTR_NS" 37 | 38 | 39 | {-| Keys that we are aware of and should pay attention to 40 | -} 41 | knownKeys : List String 42 | knownKeys = 43 | [ styleKey, eventKey, attributeKey, attributeNamespaceKey ] 44 | -------------------------------------------------------------------------------- /src/ElmHtml/Helpers.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.Helpers exposing (..) 2 | 3 | {-| 4 | Internal helpers for ElmHtml 5 | 6 | @docs filterKnownKeys 7 | -} 8 | 9 | import Dict exposing (Dict) 10 | import ElmHtml.Constants exposing (..) 11 | 12 | 13 | {-| Filter out keys that we don't know 14 | -} 15 | filterKnownKeys : Dict String a -> Dict String a 16 | filterKnownKeys = 17 | Dict.filter (\key _ -> not (List.member key knownKeys)) 18 | -------------------------------------------------------------------------------- /src/ElmHtml/InternalTypes.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.InternalTypes 2 | exposing 3 | ( Attribute(..) 4 | , AttributeRecord 5 | , CustomNodeRecord 6 | , ElementKind(..) 7 | , ElmHtml(..) 8 | , EventHandler 9 | , EventRecord 10 | , Facts 11 | , MarkdownNodeRecord 12 | , NamespacedAttributeRecord 13 | , NodeRecord 14 | , PropertyRecord 15 | , Tagger 16 | , TextTagRecord 17 | , decodeAttribute 18 | , decodeElmHtml 19 | , emptyFacts 20 | , toElementKind 21 | ) 22 | 23 | {-| Internal types used to represent Elm Html in pure Elm 24 | 25 | @docs ElmHtml, TextTagRecord, NodeRecord, CustomNodeRecord, MarkdownNodeRecord 26 | 27 | @docs Facts, Tagger, EventHandler, ElementKind 28 | 29 | @docs Attribute, AttributeRecord, NamespacedAttributeRecord, PropertyRecord, EventRecord 30 | 31 | @docs decodeElmHtml, emptyFacts, toElementKind, decodeAttribute 32 | 33 | -} 34 | 35 | import Dict exposing (Dict) 36 | import ElmHtml.Constants exposing (..) 37 | import ElmHtml.Helpers exposing (..) 38 | import ElmHtml.Markdown exposing (..) 39 | import Html.Events 40 | import Json.Decode exposing (field) 41 | import Json.Encode 42 | 43 | 44 | {-| Type tree for representing Elm's Html 45 | 46 | - TextTag is just a plain old bit of text. 47 | - NodeEntry is an actual HTML node, e.g a div 48 | - CustomNode are nodes defined to work with the renderer in some way, e.g webgl/markdown 49 | - MarkdownNode is just a wrapper for CustomNode designed just for markdown 50 | 51 | -} 52 | type ElmHtml msg 53 | = TextTag TextTagRecord 54 | | NodeEntry (NodeRecord msg) 55 | | CustomNode (CustomNodeRecord msg) 56 | | MarkdownNode (MarkdownNodeRecord msg) 57 | | NoOp 58 | 59 | 60 | {-| Text tags just contain text 61 | -} 62 | type alias TextTagRecord = 63 | { text : String } 64 | 65 | 66 | {-| A node contains the `tag` as a string, the children, the facts (e.g attributes) and descendantsCount 67 | -} 68 | type alias NodeRecord msg = 69 | { tag : String 70 | , children : List (ElmHtml msg) 71 | , facts : 72 | Facts msg 73 | 74 | --, namespace : String 75 | , descendantsCount : Int 76 | } 77 | 78 | 79 | {-| A markdown node contains facts (e.g attributes) and the model used by markdown 80 | -} 81 | type alias MarkdownNodeRecord msg = 82 | { facts : Facts msg 83 | , model : MarkdownModel 84 | } 85 | 86 | 87 | {-| Custom nodes contain facts (e.g attributes) and a json value for the model 88 | -} 89 | type alias CustomNodeRecord msg = 90 | { facts : Facts msg 91 | , model : Json.Decode.Value 92 | } 93 | 94 | 95 | {-| Tagger holds the map function when Html.Map is used, the tagger 96 | should then be applied to events comming from descendant nodes, it 97 | is basically a javascript function. 98 | -} 99 | type alias Tagger = 100 | Json.Decode.Value 101 | 102 | 103 | {-| EventHandler holds the function that is called when an event is 104 | triggered, it is basically a javascript object like this: 105 | 106 | { decoder: [Function] } 107 | 108 | -} 109 | type alias EventHandler = 110 | Json.Decode.Value 111 | 112 | 113 | {-| Facts contain various dictionaries and values for a node 114 | 115 | - styles are a mapping of rules 116 | - events may be a json object containing event handlers 117 | - attributes are pulled out into stringAttributes and boolAttributes - things with string values go into 118 | stringAttributes, things with bool values go into boolAttributes 119 | 120 | -} 121 | type alias Facts msg = 122 | { styles : Dict String String 123 | , events : Dict String (Json.Decode.Decoder msg) 124 | , attributeNamespace : Maybe Json.Decode.Value 125 | , stringAttributes : Dict String String 126 | , boolAttributes : Dict String Bool 127 | } 128 | 129 | 130 | {-| Type for representing the five kinds of elements according to HTML 5 131 | [spec](https://html.spec.whatwg.org/multipage/syntax.html#elements-2). 132 | Used to handle different rendering behavior depending on the type of element. 133 | -} 134 | type ElementKind 135 | = VoidElements 136 | | RawTextElements 137 | | EscapableRawTextElements 138 | | ForeignElements 139 | | NormalElements 140 | 141 | 142 | type HtmlContext msg 143 | = HtmlContext (List Tagger) (List Tagger -> EventHandler -> Json.Decode.Decoder msg) 144 | 145 | 146 | {-| Type for representing Elm's Attributes 147 | 148 | - Attribute is an HTML attribute, like `Html.Attributes.colspan`. These values 149 | are applied using `element.setAttribute(key, value)` during a patch. 150 | - NamespacedAttribute has an namespace, like `Svg.Attributes.xlinkHref` 151 | - Property assigns a value to a node like `Html.Attributes.class`, and can 152 | hold any encoded value. Unlike attributes, where `element.setAttribute()` is 153 | used during the patch, properties are applied directly as 154 | `element[key] = value`. 155 | - Styles hold a list of key value pairs to be applied to the node's style set 156 | - Event contains a decoder for a msg and the `Html.Event.Options` for the event 157 | 158 | -} 159 | type Attribute 160 | = Attribute AttributeRecord 161 | | NamespacedAttribute NamespacedAttributeRecord 162 | | Property PropertyRecord 163 | | Styles (List ( String, String )) 164 | | Event EventRecord 165 | 166 | 167 | {-| Attribute contains a string key and a string value 168 | -} 169 | type alias AttributeRecord = 170 | { key : String 171 | , value : String 172 | } 173 | 174 | 175 | {-| NamespacedAttribute contains a string key, string namespace and string value 176 | -} 177 | type alias NamespacedAttributeRecord = 178 | { key : String 179 | , value : String 180 | , namespace : String 181 | } 182 | 183 | 184 | {-| Property contains a string key and a value with an arbitrary type 185 | -} 186 | type alias PropertyRecord = 187 | { key : String 188 | , value : Json.Decode.Value 189 | } 190 | 191 | 192 | {-| Event contains a string key, a decoder for a msg and event options 193 | -} 194 | type alias EventRecord = 195 | { key : String 196 | , decoder : Json.Decode.Value 197 | , options : Html.Events.Options 198 | } 199 | 200 | 201 | {-| decode a json object into ElmHtml, you have to pass a function that decodes 202 | events from Html Nodes. If you don't want to decode event msgs, you can ignore it: 203 | 204 | decodeElmHtml (\_ _ -> ()) jsonHtml 205 | 206 | if you do want to decode them, you will probably need to write some native code 207 | like elm-html-test does to extract the function inside those. 208 | 209 | -} 210 | decodeElmHtml : (List Tagger -> EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (ElmHtml msg) 211 | decodeElmHtml eventDecoder = 212 | contextDecodeElmHtml (HtmlContext [] eventDecoder) 213 | 214 | 215 | contextDecodeElmHtml : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg) 216 | contextDecodeElmHtml context = 217 | field "type" Json.Decode.string 218 | |> Json.Decode.andThen 219 | (\typeString -> 220 | case typeString of 221 | "text" -> 222 | Json.Decode.map TextTag decodeTextTag 223 | 224 | "keyed-node" -> 225 | Json.Decode.map NodeEntry (decodeKeyedNode context) 226 | 227 | "node" -> 228 | Json.Decode.map NodeEntry (decodeNode context) 229 | 230 | "custom" -> 231 | decodeCustomNode context 232 | 233 | "tagger" -> 234 | decodeTagger context 235 | 236 | "thunk" -> 237 | field "node" (contextDecodeElmHtml context) 238 | 239 | _ -> 240 | Json.Decode.fail ("No such type as " ++ typeString) 241 | ) 242 | 243 | 244 | {-| decode text tag 245 | -} 246 | decodeTextTag : Json.Decode.Decoder TextTagRecord 247 | decodeTextTag = 248 | field "text" (Json.Decode.andThen (\text -> Json.Decode.succeed { text = text }) Json.Decode.string) 249 | 250 | 251 | {-| encode text tag 252 | -} 253 | encodeTextTag : TextTagRecord -> Json.Encode.Value 254 | encodeTextTag { text } = 255 | Json.Encode.object [ ( "text", Json.Encode.string text ) ] 256 | 257 | 258 | {-| decode a tagger 259 | -} 260 | decodeTagger : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg) 261 | decodeTagger (HtmlContext taggers eventDecoder) = 262 | Json.Decode.field "tagger" Json.Decode.value 263 | |> Json.Decode.andThen 264 | (\tagger -> 265 | let 266 | nodeDecoder = 267 | contextDecodeElmHtml (HtmlContext (taggers ++ [ tagger ]) eventDecoder) 268 | in 269 | Json.Decode.oneOf 270 | [ Json.Decode.at [ "node" ] nodeDecoder 271 | , Json.Decode.at [ "text" ] nodeDecoder 272 | , Json.Decode.at [ "custom" ] nodeDecoder 273 | ] 274 | ) 275 | 276 | 277 | decodeKeyedNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg) 278 | decodeKeyedNode context = 279 | let 280 | -- elm stores keyed nodes as tuples 281 | -- we only want to decode the html, in the second property 282 | decodeSecondNode = 283 | Json.Decode.field "_1" (contextDecodeElmHtml context) 284 | in 285 | Json.Decode.map4 NodeRecord 286 | (Json.Decode.field "tag" Json.Decode.string) 287 | (Json.Decode.field "children" (Json.Decode.list decodeSecondNode)) 288 | (Json.Decode.field "facts" (decodeFacts context)) 289 | (Json.Decode.field "descendantsCount" Json.Decode.int) 290 | 291 | 292 | {-| decode a node record 293 | -} 294 | decodeNode : HtmlContext msg -> Json.Decode.Decoder (NodeRecord msg) 295 | decodeNode context = 296 | Json.Decode.map4 NodeRecord 297 | (field "tag" Json.Decode.string) 298 | (field "children" (Json.Decode.list (contextDecodeElmHtml context))) 299 | (field "facts" (decodeFacts context)) 300 | (field "descendantsCount" Json.Decode.int) 301 | 302 | 303 | {-| encode a node record: currently does not support facts or children 304 | -} 305 | encodeNodeRecord : NodeRecord msg -> Json.Encode.Value 306 | encodeNodeRecord record = 307 | Json.Encode.object 308 | [ ( "tag", Json.Encode.string record.tag ) 309 | 310 | --, ( "children", Json.Encode.list encodeElmHtml) 311 | --, ( "facts", encodeFacts) 312 | , ( "descendantsCount", Json.Encode.int record.descendantsCount ) 313 | ] 314 | 315 | 316 | {-| decode custom node into either markdown or custom 317 | -} 318 | decodeCustomNode : HtmlContext msg -> Json.Decode.Decoder (ElmHtml msg) 319 | decodeCustomNode context = 320 | Json.Decode.oneOf 321 | [ Json.Decode.map MarkdownNode (decodeMarkdownNodeRecord context) 322 | , Json.Decode.map CustomNode (decodeCustomNodeRecord context) 323 | ] 324 | 325 | 326 | {-| decode custom node record 327 | -} 328 | decodeCustomNodeRecord : HtmlContext msg -> Json.Decode.Decoder (CustomNodeRecord msg) 329 | decodeCustomNodeRecord context = 330 | Json.Decode.map2 CustomNodeRecord 331 | (field "facts" (decodeFacts context)) 332 | (field "model" Json.Decode.value) 333 | 334 | 335 | {-| decode markdown node record 336 | -} 337 | decodeMarkdownNodeRecord : HtmlContext msg -> Json.Decode.Decoder (MarkdownNodeRecord msg) 338 | decodeMarkdownNodeRecord context = 339 | Json.Decode.map2 MarkdownNodeRecord 340 | (field "facts" (decodeFacts context)) 341 | (field "model" decodeMarkdownModel) 342 | 343 | 344 | {-| decode the styles 345 | -} 346 | decodeStyles : Json.Decode.Decoder (Dict String String) 347 | decodeStyles = 348 | Json.Decode.oneOf 349 | [ field styleKey (Json.Decode.dict Json.Decode.string) 350 | , Json.Decode.succeed Dict.empty 351 | ] 352 | 353 | 354 | {-| encode styles 355 | -} 356 | encodeStyles : Dict String String -> Json.Encode.Value 357 | encodeStyles stylesDict = 358 | let 359 | encodedDict = 360 | stylesDict 361 | |> Dict.toList 362 | |> List.map (\( k, v ) -> ( k, Json.Encode.string v )) 363 | in 364 | Json.Encode.object [ ( styleKey, Json.Encode.object encodedDict ) ] 365 | 366 | 367 | {-| grab things from attributes via a decoder, then anything that isn't filtered on 368 | the object 369 | -} 370 | decodeOthers : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a) 371 | decodeOthers otherDecoder = 372 | decodeAttributes otherDecoder 373 | |> Json.Decode.andThen 374 | (\attributes -> 375 | decodeDictFilterMap otherDecoder 376 | |> Json.Decode.map (filterKnownKeys >> Dict.union attributes) 377 | ) 378 | 379 | 380 | {-| For a given decoder, keep the values from a dict that pass the decoder 381 | -} 382 | decodeDictFilterMap : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a) 383 | decodeDictFilterMap decoder = 384 | Json.Decode.dict Json.Decode.value 385 | |> Json.Decode.map 386 | (Dict.toList 387 | >> List.filterMap 388 | (\( key, value ) -> 389 | case Json.Decode.decodeValue decoder value of 390 | Err _ -> 391 | Nothing 392 | 393 | Ok v -> 394 | Just ( key, v ) 395 | ) 396 | >> Dict.fromList 397 | ) 398 | 399 | 400 | decodeAttributes : Json.Decode.Decoder a -> Json.Decode.Decoder (Dict String a) 401 | decodeAttributes decoder = 402 | Json.Decode.oneOf 403 | [ Json.Decode.field attributeKey (decodeDictFilterMap decoder) 404 | , Json.Decode.succeed Dict.empty 405 | ] 406 | 407 | 408 | decodeEvents : (EventHandler -> Json.Decode.Decoder msg) -> Json.Decode.Decoder (Dict String (Json.Decode.Decoder msg)) 409 | decodeEvents taggedEventDecoder = 410 | Json.Decode.oneOf 411 | [ Json.Decode.field eventKey (Json.Decode.dict (Json.Decode.map taggedEventDecoder Json.Decode.value)) 412 | , Json.Decode.succeed Dict.empty 413 | ] 414 | 415 | 416 | {-| decode fact 417 | -} 418 | decodeFacts : HtmlContext msg -> Json.Decode.Decoder (Facts msg) 419 | decodeFacts (HtmlContext taggers eventDecoder) = 420 | Json.Decode.map5 Facts 421 | decodeStyles 422 | (decodeEvents (eventDecoder taggers)) 423 | (Json.Decode.maybe (Json.Decode.field attributeNamespaceKey Json.Decode.value)) 424 | (decodeOthers Json.Decode.string) 425 | (decodeOthers Json.Decode.bool) 426 | 427 | 428 | {-| Just empty facts 429 | -} 430 | emptyFacts : Facts msg 431 | emptyFacts = 432 | { styles = Dict.empty 433 | , events = Dict.empty 434 | , attributeNamespace = Nothing 435 | , stringAttributes = Dict.empty 436 | , boolAttributes = Dict.empty 437 | } 438 | 439 | 440 | {-| Decode a JSON object into an Attribute. You have to pass a function that 441 | decodes events from event attributes. If you don't want to decode event msgs, 442 | you can ignore it: 443 | 444 | decodeAttribute (\_ -> ()) jsonHtml 445 | 446 | If you do want to decode them, you will probably need to write some native code 447 | like elm-html-test does to extract the function inside those. 448 | 449 | -} 450 | decodeAttribute : Json.Decode.Decoder Attribute 451 | decodeAttribute = 452 | Json.Decode.field "key" Json.Decode.string 453 | |> Json.Decode.andThen 454 | (\key -> 455 | if key == attributeKey then 456 | Json.Decode.map2 AttributeRecord 457 | (Json.Decode.field "realKey" Json.Decode.string) 458 | (Json.Decode.field "value" Json.Decode.string) 459 | |> Json.Decode.map Attribute 460 | else if key == attributeNamespaceKey then 461 | Json.Decode.map3 NamespacedAttributeRecord 462 | (Json.Decode.field "realKey" Json.Decode.string) 463 | (Json.Decode.at [ "value", "value" ] Json.Decode.string) 464 | (Json.Decode.at [ "value", "namespace" ] Json.Decode.string) 465 | |> Json.Decode.map NamespacedAttribute 466 | else if key == styleKey then 467 | Json.Decode.map2 (,) 468 | (Json.Decode.field "_0" Json.Decode.string) 469 | (Json.Decode.field "_1" Json.Decode.string) 470 | |> elmListDecoder 471 | |> Json.Decode.field "value" 472 | |> Json.Decode.map Styles 473 | else if key == eventKey then 474 | Json.Decode.map3 EventRecord 475 | (Json.Decode.field "realKey" Json.Decode.string) 476 | (Json.Decode.at [ "value", "decoder" ] Json.Decode.value) 477 | (Json.Decode.at [ "value", "options" ] decodeOptions) 478 | |> Json.Decode.map Event 479 | else 480 | Json.Decode.field "value" Json.Decode.value 481 | |> Json.Decode.map (PropertyRecord key >> Property) 482 | ) 483 | 484 | 485 | decodeOptions : Json.Decode.Decoder Html.Events.Options 486 | decodeOptions = 487 | Json.Decode.map2 Html.Events.Options 488 | (Json.Decode.field "stopPropagation" Json.Decode.bool) 489 | (Json.Decode.field "preventDefault" Json.Decode.bool) 490 | 491 | 492 | elmListDecoder : Json.Decode.Decoder a -> Json.Decode.Decoder (List a) 493 | elmListDecoder itemDecoder = 494 | elmListDecoderHelp itemDecoder [] 495 | |> Json.Decode.map List.reverse 496 | 497 | 498 | elmListDecoderHelp : Json.Decode.Decoder a -> List a -> Json.Decode.Decoder (List a) 499 | elmListDecoderHelp itemDecoder items = 500 | Json.Decode.field "ctor" Json.Decode.string 501 | |> Json.Decode.andThen 502 | (\ctor -> 503 | case ctor of 504 | "[]" -> 505 | Json.Decode.succeed items 506 | 507 | "::" -> 508 | Json.Decode.field "_0" itemDecoder 509 | |> Json.Decode.andThen 510 | (\value -> 511 | Json.Decode.field "_1" (elmListDecoderHelp itemDecoder (value :: items)) 512 | ) 513 | 514 | _ -> 515 | Json.Decode.fail <| "Unrecognized constructor for an Elm List: " ++ ctor 516 | ) 517 | 518 | 519 | {-| A list of Void elements as defined by the HTML5 specification. These 520 | elements must not have closing tags and most not be written as self closing 521 | either 522 | -} 523 | voidElements : List String 524 | voidElements = 525 | [ "area" 526 | , "base" 527 | , "br" 528 | , "col" 529 | , "embed" 530 | , "hr" 531 | , "img" 532 | , "input" 533 | , "link" 534 | , "meta" 535 | , "param" 536 | , "source" 537 | , "track" 538 | , "wbr" 539 | ] 540 | 541 | 542 | {-| A list of all Raw Text Elements as defined by the HTML5 specification. They 543 | can contain only text and have restrictions on which characters can appear 544 | within its innerHTML 545 | -} 546 | rawTextElements : List String 547 | rawTextElements = 548 | [ "script", "style" ] 549 | 550 | 551 | {-| A list of all Escapable Raw Text Elements as defined by the HTML5 552 | specification. They can have text and character references, but the text must 553 | not contain an ambiguous ampersand along with addional restrictions: 554 | 555 | -} 556 | escapableRawTextElements : List String 557 | escapableRawTextElements = 558 | [ "textarea", "title" ] 559 | 560 | 561 | 562 | {- Foreign elements are elements from the MathML namespace and the 563 | SVG namespace. TODO: detect these nodes and handle them correctly. Right 564 | now they will just be treated as Normal elements. 565 | -} 566 | 567 | 568 | {-| Identify the kind of element. Helper to convert an tag name into a type for 569 | pattern matching. 570 | -} 571 | toElementKind : String -> ElementKind 572 | toElementKind element = 573 | if List.member element voidElements then 574 | VoidElements 575 | else if List.member element rawTextElements then 576 | RawTextElements 577 | else if List.member element escapableRawTextElements then 578 | EscapableRawTextElements 579 | else 580 | -- All other allowed HTML elements are normal elements 581 | NormalElements 582 | -------------------------------------------------------------------------------- /src/ElmHtml/Markdown.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.Markdown exposing (..) 2 | 3 | {-| Markdown helpers 4 | 5 | @docs MarkdownOptions, MarkdownModel, baseMarkdownModel 6 | 7 | @docs encodeOptions, encodeMarkdownModel, decodeMarkdownModel 8 | 9 | -} 10 | 11 | import Json.Encode 12 | import Json.Decode exposing (field) 13 | 14 | 15 | {-| Just a default markdown model 16 | -} 17 | baseMarkdownModel : MarkdownModel 18 | baseMarkdownModel = 19 | { options = 20 | { githubFlavored = Just { tables = False, breaks = False } 21 | , defaultHighlighting = Nothing 22 | , sanitize = False 23 | , smartypants = False 24 | } 25 | , markdown = "" 26 | } 27 | 28 | 29 | {-| options markdown expects 30 | -} 31 | type alias MarkdownOptions = 32 | { githubFlavored : Maybe { tables : Bool, breaks : Bool } 33 | , defaultHighlighting : Maybe String 34 | , sanitize : Bool 35 | , smartypants : Bool 36 | } 37 | 38 | 39 | {-| An internal markdown model. Options are the things you give markdown, markdown is the string 40 | -} 41 | type alias MarkdownModel = 42 | { options : MarkdownOptions 43 | , markdown : String 44 | } 45 | 46 | 47 | {-| We don't really care about encoding options right now 48 | TODO: we will if we want to represent things as we do for elm-html 49 | -} 50 | encodeOptions : MarkdownOptions -> Json.Decode.Value 51 | encodeOptions options = 52 | Json.Encode.null 53 | 54 | 55 | {-| encode markdown model 56 | -} 57 | encodeMarkdownModel : MarkdownModel -> Json.Decode.Value 58 | encodeMarkdownModel model = 59 | Json.Encode.object 60 | [ ( "options", encodeOptions model.options ) 61 | , ( "markdown", Json.Encode.string model.markdown ) 62 | ] 63 | 64 | 65 | {-| decode a markdown model 66 | -} 67 | decodeMarkdownModel : Json.Decode.Decoder MarkdownModel 68 | decodeMarkdownModel = 69 | field "markdown" Json.Decode.string 70 | |> Json.Decode.map (MarkdownModel baseMarkdownModel.options) 71 | -------------------------------------------------------------------------------- /src/ElmHtml/ToElmString.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.ToElmString 2 | exposing 3 | ( toElmString 4 | , nodeRecordToString 5 | , toElmStringWithOptions 6 | , FormatOptions 7 | , defaultFormatOptions 8 | ) 9 | 10 | {-| Convert ElmHtml to string of Elm code. 11 | 12 | @docs nodeRecordToString, toElmString, toElmStringWithOptions 13 | 14 | @docs FormatOptions, defaultFormatOptions 15 | 16 | -} 17 | 18 | import String 19 | import Dict exposing (Dict) 20 | import ElmHtml.InternalTypes exposing (..) 21 | 22 | 23 | {-| Formatting options to be used for converting to string 24 | -} 25 | type alias FormatOptions = 26 | { indent : Int 27 | , newLines : Bool 28 | } 29 | 30 | 31 | {-| default formatting options 32 | -} 33 | defaultFormatOptions : FormatOptions 34 | defaultFormatOptions = 35 | { indent = 0 36 | , newLines = False 37 | } 38 | 39 | 40 | nodeToLines : FormatOptions -> ElmHtml msg -> List String 41 | nodeToLines options nodeType = 42 | case nodeType of 43 | TextTag { text } -> 44 | [ "Html.text \"" ++ text ++ "\"" ] 45 | 46 | NodeEntry record -> 47 | nodeRecordToString options record 48 | 49 | CustomNode record -> 50 | [] 51 | 52 | MarkdownNode record -> 53 | [ record.model.markdown ] 54 | 55 | NoOp -> 56 | [] 57 | 58 | 59 | {-| Convert a given html node to a string based on the type 60 | -} 61 | toElmString : ElmHtml msg -> String 62 | toElmString = 63 | toElmStringWithOptions defaultFormatOptions 64 | 65 | 66 | {-| same as toElmString, but with options 67 | -} 68 | toElmStringWithOptions : FormatOptions -> ElmHtml msg -> String 69 | toElmStringWithOptions options = 70 | nodeToLines options 71 | >> String.join 72 | (if options.newLines then 73 | "\n" 74 | else 75 | "" 76 | ) 77 | 78 | 79 | {-| Convert a node record to a string. This basically takes the tag name, then 80 | pulls all the facts into tag declaration, then goes through the children and 81 | nests them under this one 82 | -} 83 | nodeRecordToString : FormatOptions -> NodeRecord msg -> List String 84 | nodeRecordToString options { tag, children, facts } = 85 | let 86 | openTag : List (Maybe String) -> String 87 | openTag extras = 88 | let 89 | trimmedExtras = 90 | List.filterMap (\x -> x) extras 91 | |> List.map String.trim 92 | |> List.filter ((/=) "") 93 | 94 | filling = 95 | case trimmedExtras of 96 | [] -> 97 | "" 98 | 99 | more -> 100 | " " ++ (String.join " " more) 101 | in 102 | "Html." ++ tag ++ " [" ++ filling 103 | 104 | childrenStrings = 105 | List.map (nodeToLines options) children 106 | |> List.concat 107 | |> List.map ((++) (String.repeat options.indent " ")) 108 | 109 | styles = 110 | case Dict.toList facts.styles of 111 | [] -> 112 | Nothing 113 | 114 | styles -> 115 | styles 116 | |> List.map (\( key, value ) -> "(\"" ++ key ++ "\",\"" ++ value ++ "\")") 117 | |> String.join ", " 118 | |> (\styleString -> "Html.Attributes.style [" ++ styleString ++ "]") 119 | |> Just 120 | 121 | classes = 122 | Dict.get "className" facts.stringAttributes 123 | |> Maybe.map (\name -> "Html.Attributes.class [\"" ++ name ++ "\"]") 124 | 125 | stringAttributes = 126 | Dict.filter (\k v -> k /= "className") facts.stringAttributes 127 | |> Dict.toList 128 | |> List.map (\( k, v ) -> "Html.Attributes." ++ k ++ " \"" ++ v ++ "\"") 129 | |> String.join ", " 130 | |> Just 131 | 132 | boolAttributes = 133 | Dict.toList facts.boolAttributes 134 | |> List.map (\( k, v ) -> "Html.Attributes.property \"" ++ k ++ "\" <| Json.Encode.bool " ++ toString v) 135 | |> String.join " " 136 | |> Just 137 | in 138 | [ openTag [ classes, styles, stringAttributes, boolAttributes ] ] 139 | ++ [ " ] " 140 | , "[ " 141 | , String.join "" childrenStrings 142 | , "]" 143 | ] 144 | -------------------------------------------------------------------------------- /src/ElmHtml/ToHtml.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.ToHtml exposing (toHtml, factsToAttributes) 2 | 3 | {-| This module is particularly useful for putting parsed Html into Elm.Html at runtime. 4 | Estentially allowing the user to use tools like html-to-elm on their code. 5 | 6 | @docs toHtml, factsToAttributes 7 | 8 | -} 9 | 10 | import String 11 | import Dict exposing (Dict) 12 | import ElmHtml.InternalTypes exposing (..) 13 | import Html 14 | import Html.Attributes 15 | import Html.Events 16 | import Json.Encode 17 | import Json.Decode 18 | 19 | 20 | {-| Turns ElmHtml into normal Elm Html 21 | -} 22 | toHtml : ElmHtml msg -> Html.Html msg 23 | toHtml elmHtml = 24 | case elmHtml of 25 | TextTag text -> 26 | Html.text text.text 27 | 28 | NodeEntry { tag, children, facts } -> 29 | Html.node tag [] (List.map toHtml children) 30 | 31 | CustomNode record -> 32 | let 33 | _ = 34 | Debug.log "Custom node is not supported" "" 35 | in 36 | Html.text "" 37 | 38 | MarkdownNode record -> 39 | let 40 | _ = 41 | Debug.log "Markdown node is not supported" "" 42 | in 43 | Html.text "" 44 | 45 | NoOp -> 46 | Html.text "" 47 | 48 | 49 | stylesToAttribute : Dict String String -> Html.Attribute msg 50 | stylesToAttribute = 51 | Dict.toList 52 | >> Html.Attributes.style 53 | 54 | 55 | eventsToAttributes : Dict String (Json.Decode.Decoder msg) -> List (Html.Attribute msg) 56 | eventsToAttributes = 57 | Dict.toList 58 | >> List.map (\( x, y ) -> Html.Events.on x y) 59 | 60 | 61 | stringAttributesToAttributes : Dict String String -> List (Html.Attribute msg) 62 | stringAttributesToAttributes = 63 | Dict.toList 64 | >> List.map (\( x, y ) -> Html.Attributes.attribute x y) 65 | 66 | 67 | boolAttributesToAttributes : Dict String Bool -> List (Html.Attribute msg) 68 | boolAttributesToAttributes = 69 | Dict.toList 70 | >> List.map (\( x, y ) -> Html.Attributes.property x (Json.Encode.bool y)) 71 | 72 | 73 | {-| Turns a fact record into a list of attributes 74 | -} 75 | factsToAttributes : Facts msg -> List (Html.Attribute msg) 76 | factsToAttributes facts = 77 | List.concat 78 | [ [ stylesToAttribute facts.styles ] 79 | , eventsToAttributes facts.events 80 | , stringAttributesToAttributes facts.stringAttributes 81 | , boolAttributesToAttributes facts.boolAttributes 82 | ] 83 | -------------------------------------------------------------------------------- /src/ElmHtml/ToString.elm: -------------------------------------------------------------------------------- 1 | module ElmHtml.ToString 2 | exposing 3 | ( nodeToString 4 | , nodeRecordToString 5 | , nodeToStringWithOptions 6 | , FormatOptions 7 | , defaultFormatOptions 8 | ) 9 | 10 | {-| Convert ElmHtml to string. 11 | 12 | @docs nodeRecordToString, nodeToString, nodeToStringWithOptions 13 | 14 | @docs FormatOptions, defaultFormatOptions 15 | -} 16 | 17 | import String 18 | import Dict exposing (Dict) 19 | import ElmHtml.InternalTypes exposing (..) 20 | 21 | 22 | {-| Formatting options to be used for converting to string 23 | -} 24 | type alias FormatOptions = 25 | { indent : Int 26 | , newLines : Bool 27 | } 28 | 29 | 30 | {-| default formatting options 31 | -} 32 | defaultFormatOptions : FormatOptions 33 | defaultFormatOptions = 34 | { indent = 0 35 | , newLines = False 36 | } 37 | 38 | 39 | nodeToLines : FormatOptions -> ElmHtml msg -> List String 40 | nodeToLines options nodeType = 41 | case nodeType of 42 | TextTag { text } -> 43 | [ text ] 44 | 45 | NodeEntry record -> 46 | nodeRecordToString options record 47 | 48 | CustomNode record -> 49 | [] 50 | 51 | MarkdownNode record -> 52 | [ record.model.markdown ] 53 | 54 | NoOp -> 55 | [] 56 | 57 | 58 | {-| Convert a given html node to a string based on the type 59 | -} 60 | nodeToString : ElmHtml msg -> String 61 | nodeToString = 62 | nodeToStringWithOptions defaultFormatOptions 63 | 64 | 65 | {-| same as nodeToString, but with options 66 | -} 67 | nodeToStringWithOptions : FormatOptions -> ElmHtml msg -> String 68 | nodeToStringWithOptions options = 69 | nodeToLines options 70 | >> String.join 71 | (if options.newLines then 72 | "\n" 73 | else 74 | "" 75 | ) 76 | 77 | 78 | {-| Convert a node record to a string. This basically takes the tag name, then 79 | pulls all the facts into tag declaration, then goes through the children and 80 | nests them under this one 81 | -} 82 | nodeRecordToString : FormatOptions -> NodeRecord msg -> List String 83 | nodeRecordToString options { tag, children, facts } = 84 | let 85 | openTag : List (Maybe String) -> String 86 | openTag extras = 87 | let 88 | trimmedExtras = 89 | List.filterMap (\x -> x) extras 90 | |> List.map String.trim 91 | |> List.filter ((/=) "") 92 | 93 | filling = 94 | case trimmedExtras of 95 | [] -> 96 | "" 97 | 98 | more -> 99 | " " ++ (String.join " " more) 100 | in 101 | "<" ++ tag ++ filling ++ ">" 102 | 103 | closeTag = 104 | "" 105 | 106 | childrenStrings = 107 | List.map (nodeToLines options) children 108 | |> List.concat 109 | |> List.map ((++) (String.repeat options.indent " ")) 110 | 111 | styles = 112 | case Dict.toList facts.styles of 113 | [] -> 114 | Nothing 115 | 116 | styles -> 117 | styles 118 | |> List.map (\( key, value ) -> key ++ ":" ++ value ++ ";") 119 | |> String.join "" 120 | |> (\styleString -> "style=\"" ++ styleString ++ "\"") 121 | |> Just 122 | 123 | classes = 124 | Dict.get "className" facts.stringAttributes 125 | |> Maybe.map (\name -> "class=\"" ++ name ++ "\"") 126 | 127 | stringAttributes = 128 | Dict.filter (\k v -> k /= "className") facts.stringAttributes 129 | |> Dict.toList 130 | |> List.map (\( k, v ) -> k ++ "=\"" ++ v ++ "\"") 131 | |> String.join " " 132 | |> Just 133 | 134 | boolAttributes = 135 | Dict.toList facts.boolAttributes 136 | |> List.map (\( k, v ) -> k ++ "=" ++ (String.toLower <| toString v)) 137 | |> String.join " " 138 | |> Just 139 | in 140 | case toElementKind tag of 141 | {- Void elements only have a start tag; end tags must not be 142 | specified for void elements. 143 | -} 144 | VoidElements -> 145 | [ openTag [ classes, styles, stringAttributes, boolAttributes ] ] 146 | 147 | {- TODO: implement restrictions for RawTextElements, 148 | EscapableRawTextElements. Also handle ForeignElements correctly. 149 | For now just punt and use the previous behavior for all other 150 | element kinds. 151 | -} 152 | _ -> 153 | [ openTag [ classes, styles, stringAttributes, boolAttributes ] ] 154 | ++ childrenStrings 155 | ++ [ closeTag ] 156 | -------------------------------------------------------------------------------- /tests/Native/HtmlAsJson.js: -------------------------------------------------------------------------------- 1 | var _eeue56$elm_html_in_elm$Native_HtmlAsJson = (function() { 2 | return { 3 | unsafeCoerce: function(a) { 4 | return a; 5 | }, 6 | eventDecoder: function (event) { 7 | return event.decoder; 8 | }, 9 | eventHandler: F2(function(eventName, html) { 10 | return html.facts.EVENT[eventName]; 11 | }), 12 | taggerFunction: function(tagger) { 13 | return tagger; 14 | } 15 | }; 16 | })(); 17 | -------------------------------------------------------------------------------- /tests/Tests.elm: -------------------------------------------------------------------------------- 1 | module Tests exposing (..) 2 | 3 | import Dict 4 | import ElmHtml.InternalTypes exposing (Attribute(..), ElmHtml(..), EventHandler, Facts, NodeRecord, Tagger, decodeAttribute, decodeElmHtml) 5 | import ElmHtml.ToHtml 6 | import ElmHtml.ToElmString exposing (toElmString) 7 | import Expect 8 | import Html exposing (Html, button, div, input, text) 9 | import Html.Attributes exposing (class, colspan, disabled, style, value) 10 | import Html.Events exposing (onCheck, onClick, onInput) 11 | import Json.Decode exposing (decodeValue) 12 | import Json.Encode 13 | import Native.HtmlAsJson 14 | import Svg.Attributes exposing (xlinkHref) 15 | import Test exposing (..) 16 | 17 | 18 | elmHtml : Test 19 | elmHtml = 20 | describe "ElmHtml parsing" 21 | [ test "parsing a node" <| 22 | \() -> 23 | div [] [] 24 | |> fromHtml 25 | |> Expect.equal (Ok (NodeEntry decodedNode)) 26 | , test "parsing a text" <| 27 | \() -> 28 | text "foo" 29 | |> fromHtml 30 | |> Expect.equal (Ok (TextTag { text = "foo" })) 31 | , test "parsing attributes" <| 32 | \() -> 33 | let 34 | facts = 35 | { decodedFacts 36 | | stringAttributes = Dict.fromList [ ( "className", "foo" ), ( "value", "bar" ) ] 37 | , boolAttributes = Dict.fromList [ ( "disabled", True ) ] 38 | } 39 | 40 | expected = 41 | { decodedNode | tag = "button", facts = facts } 42 | in 43 | button [ class "foo", value "bar", disabled True ] [] 44 | |> fromHtml 45 | |> Expect.equal (Ok (NodeEntry expected)) 46 | , test "parsing children" <| 47 | \() -> 48 | let 49 | expected = 50 | { decodedNode 51 | | children = [ NodeEntry decodedNode, TextTag { text = "foo" } ] 52 | , descendantsCount = 2 53 | } 54 | in 55 | div [] 56 | [ div [] [] 57 | , text "foo" 58 | ] 59 | |> fromHtml 60 | |> Expect.equal (Ok (NodeEntry expected)) 61 | , describe "parsing events" 62 | [ testParsingEvent "click" (onClick SomeMsg) 63 | , testParsingEvent "input" (onInput InputMsg) 64 | , testParsingEvent "change" (onCheck CheckMsg) 65 | ] 66 | , describe "parsing Html.map" 67 | [ test "adds the correct tagger to a mapped button" <| 68 | \() -> 69 | let 70 | taggedNode = 71 | input [ onInput identity ] [] 72 | |> Html.map (\msg -> msg ++ "bar") 73 | |> fromHtml 74 | in 75 | taggedNode 76 | |> Result.andThen (simulate "input" "{\"target\": {\"value\": \"foo\"}}") 77 | |> Expect.equal (Ok "foobar") 78 | , test "adds two taggers to a double mapped button with changing types" <| 79 | \() -> 80 | let 81 | taggedNode = 82 | input [ onInput identity ] [] 83 | |> Html.map (\str -> [ str ] ++ [ "bar" ]) 84 | |> Html.map (\list -> ( list, "baz" )) 85 | |> fromHtml 86 | in 87 | taggedNode 88 | |> Result.andThen (simulate "input" "{\"target\": {\"value\": \"foo\"}}") 89 | |> Expect.equal (Ok ( [ "foo", "bar" ], "baz" )) 90 | ] 91 | ] 92 | 93 | 94 | elmHtmlToHtml : Test 95 | elmHtmlToHtml = 96 | describe "Turning the AST into Html" 97 | [ test "parsing a node" <| 98 | \() -> 99 | div [] [] 100 | |> fromHtml 101 | |> Result.map ElmHtml.ToHtml.toHtml 102 | |> Expect.equal (Ok <| div [] []) 103 | , test "parsing a text" <| 104 | \() -> 105 | text "foo" 106 | |> fromHtml 107 | |> Result.map ElmHtml.ToHtml.toHtml 108 | |> Expect.equal (Ok <| text "foo") 109 | , test "parsing a text in a div" <| 110 | \() -> 111 | div [] [ text "foo" ] 112 | |> fromHtml 113 | |> Result.map ElmHtml.ToHtml.toHtml 114 | |> Expect.equal (Ok <| div [] [ text "foo" ]) 115 | , test "parsing a text in a div in a div in a div " <| 116 | \() -> 117 | div [] [ div [] [ text "banana", div [] [ text "foo", text "bar" ] ] ] 118 | |> fromHtml 119 | |> Result.map ElmHtml.ToHtml.toHtml 120 | |> Expect.equal (Ok <| div [] [ div [] [ text "banana", div [] [ text "foo", text "bar" ] ] ]) 121 | , test "parsing styles in a div" <| 122 | \() -> 123 | div [ Html.Attributes.style [ ( "background", "red" ) ] ] [ text "foo" ] 124 | |> fromHtml 125 | |> Result.map ElmHtml.ToHtml.toHtml 126 | |> Expect.equal (Ok <| div [ Html.Attributes.style [ ( "background", "red" ) ] ] [ text "foo" ]) 127 | , test "parsing attributes a div" <| 128 | \() -> 129 | div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ text "foo" ] 130 | |> fromHtml 131 | |> Result.map ElmHtml.ToHtml.toHtml 132 | |> Expect.equal (Ok <| div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ text "foo" ]) 133 | , test "parsing attributes in a nested div" <| 134 | \() -> 135 | div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ Html.li [ Html.Attributes.type_ "hello" ] [ text "foo" ] ] 136 | |> fromHtml 137 | |> Result.map ElmHtml.ToHtml.toHtml 138 | |> Expect.equal (Ok <| div [ Html.Attributes.name "fish", Html.Attributes.checked True ] [ Html.li [ Html.Attributes.type_ "hello" ] [ text "foo" ] ]) 139 | , test "parsing events in a div" <| 140 | \() -> 141 | div [ Html.Events.onClick True ] [] 142 | |> fromHtml 143 | |> Result.map ElmHtml.ToHtml.toHtml 144 | |> Expect.equal (Ok <| div [ Html.Events.onClick True ] []) 145 | ] 146 | 147 | 148 | elmHtmlToElmString : Test 149 | elmHtmlToElmString = 150 | describe "Turning the AST into Elm, but as a string" 151 | [ test "parsing a node" <| 152 | \() -> 153 | div [] [] 154 | |> fromHtml 155 | |> Result.map toElmString 156 | |> Expect.equal (Ok <| "Html.div [ ] [ ]") 157 | , test "parsing a text" <| 158 | \() -> 159 | text "foo" 160 | |> fromHtml 161 | |> Result.map toElmString 162 | |> Expect.equal (Ok <| "Html.text \"foo\"") 163 | , test "parsing a nested node" <| 164 | \() -> 165 | div [] [ div [] [ text "hello" ] ] 166 | |> fromHtml 167 | |> Result.map toElmString 168 | |> Expect.equal (Ok <| "Html.div [ ] [ Html.div [ ] [ Html.text \"hello\"]]") 169 | , test "parsing an attribute" <| 170 | \() -> 171 | div [ Html.Attributes.checked True ] [ text "hello" ] 172 | |> fromHtml 173 | |> Result.map toElmString 174 | |> Expect.equal (Ok <| "Html.div [ Html.Attributes.property \"checked\" <| Json.Encode.bool True ] [ Html.text \"hello\"]") 175 | ] 176 | 177 | 178 | attributes : Test 179 | attributes = 180 | describe "Attribute parsing" 181 | [ test "parsing Attribute" <| 182 | \() -> 183 | colspan 1 184 | |> fromAttribute 185 | |> Expect.equal (Ok (Attribute { key = "colspan", value = "1" })) 186 | , test "parsing NamespacedAttribute" <| 187 | \() -> 188 | xlinkHref "#id" 189 | |> fromAttribute 190 | |> Expect.equal 191 | (Ok (NamespacedAttribute { key = "xlink:href", value = "#id", namespace = "http://www.w3.org/1999/xlink" })) 192 | , test "parsing Property" <| 193 | \() -> 194 | disabled True 195 | |> fromAttribute 196 | |> Expect.equal (Ok (Property { key = "disabled", value = Json.Encode.bool True })) 197 | , test "parsing Event" <| 198 | \() -> 199 | onClick () 200 | |> fromAttribute 201 | |> Expect.equal 202 | (Ok (Event { key = "click", decoder = toJson (Json.Decode.succeed ()), options = Html.Events.defaultOptions })) 203 | , test "parsing Styles" <| 204 | \() -> 205 | style [ ( "margin", "0" ) ] 206 | |> fromAttribute 207 | |> Expect.equal (Ok (Styles [ ( "margin", "0" ) ])) 208 | ] 209 | 210 | 211 | type Msg 212 | = SomeMsg 213 | | InputMsg String 214 | | CheckMsg Bool 215 | 216 | 217 | toJson : a -> Json.Decode.Value 218 | toJson = 219 | Native.HtmlAsJson.unsafeCoerce 220 | 221 | 222 | eventDecoder : EventHandler -> Json.Decode.Decoder msg 223 | eventDecoder eventHandler = 224 | Native.HtmlAsJson.eventDecoder eventHandler 225 | 226 | 227 | eventHandler : String -> Html a -> Json.Decode.Value 228 | eventHandler eventName node = 229 | Native.HtmlAsJson.eventHandler eventName node 230 | 231 | 232 | taggerFunction : Tagger -> (a -> msg) 233 | taggerFunction tagger = 234 | Native.HtmlAsJson.taggerFunction tagger 235 | 236 | 237 | taggedEventDecoder : List Tagger -> EventHandler -> Json.Decode.Decoder msg 238 | taggedEventDecoder taggers eventHandler = 239 | case taggers of 240 | [] -> 241 | eventDecoder eventHandler 242 | 243 | [ tagger ] -> 244 | Json.Decode.map (taggerFunction tagger) (eventDecoder eventHandler) 245 | 246 | tagger :: taggers -> 247 | Json.Decode.map (taggerFunction tagger) (taggedEventDecoder taggers eventHandler) 248 | 249 | 250 | fromAttribute : Html.Attribute a -> Result String Attribute 251 | fromAttribute attribute = 252 | toJson attribute 253 | |> decodeValue decodeAttribute 254 | 255 | 256 | decodedNode : NodeRecord msg 257 | decodedNode = 258 | { tag = "div" 259 | , children = [] 260 | , facts = decodedFacts 261 | , descendantsCount = 0 262 | } 263 | 264 | 265 | decodedFacts : Facts msg 266 | decodedFacts = 267 | { styles = Dict.fromList [] 268 | , events = Dict.fromList [] 269 | , attributeNamespace = Nothing 270 | , stringAttributes = Dict.fromList [] 271 | , boolAttributes = Dict.fromList [] 272 | } 273 | 274 | 275 | fromHtml : Html a -> Result String (ElmHtml msg) 276 | fromHtml html = 277 | toJson html 278 | |> decodeValue (decodeElmHtml taggedEventDecoder) 279 | 280 | 281 | simulate : String -> String -> ElmHtml msg -> Result String msg 282 | simulate eventName event parsedHtml = 283 | case parsedHtml of 284 | NodeEntry node -> 285 | Dict.get eventName node.facts.events 286 | |> Result.fromMaybe "Tried to trigger event on something other than a NodeEntry" 287 | |> Result.andThen (\eventDecoder -> Json.Decode.decodeString eventDecoder event) 288 | 289 | _ -> 290 | Err "Tried to trigger event on something other than a NodeEntry" 291 | 292 | 293 | testParsingEvent : String -> Html.Attribute a -> Test 294 | testParsingEvent eventName eventAttribute = 295 | test ("parsing " ++ eventName) <| 296 | \() -> 297 | let 298 | node = 299 | button [ eventAttribute ] [] 300 | 301 | facts = 302 | { decodedFacts 303 | | events = Dict.fromList [ ( eventName, eventDecoder (eventHandler eventName node) ) ] 304 | } 305 | 306 | expected = 307 | { decodedNode | tag = "button", facts = facts } 308 | in 309 | node 310 | |> fromHtml 311 | |> Expect.equal (Ok (NodeEntry expected)) 312 | -------------------------------------------------------------------------------- /tests/elm-package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "1.0.0", 3 | "summary": "Test Suites", 4 | "repository": "https://github.com/eeue56/elm-html-in-elm.git", 5 | "license": "BSD3", 6 | "source-directories": [ 7 | "../src", 8 | "." 9 | ], 10 | "exposed-modules": [], 11 | "native-modules": true, 12 | "dependencies": { 13 | "elm-community/elm-test": "4.0.0 <= v < 5.0.0", 14 | "elm-lang/core": "5.0.0 <= v < 6.0.0", 15 | "elm-lang/html": "2.0.0 <= v < 3.0.0", 16 | "elm-lang/svg": "2.0.0 <= v < 3.0.0" 17 | }, 18 | "elm-version": "0.18.0 <= v < 0.19.0" 19 | } 20 | --------------------------------------------------------------------------------