Skip to content

Commit

Permalink
Merge pull request #5342 from StachuDotNet/add-basic-html-functionality
Browse files Browse the repository at this point in the history
Add basic html functionality
  • Loading branch information
StachuDotNet authored Mar 29, 2024
2 parents c3689c9 + 2624d2d commit a68b808
Show file tree
Hide file tree
Showing 3 changed files with 233 additions and 152 deletions.
78 changes: 78 additions & 0 deletions backend/testfiles/execution/stdlib/html.dark
Original file line number Diff line number Diff line change
@@ -0,0 +1,78 @@
// TODO: a lot more tests.

// aliases and helpers
type HtmlTag = Stdlib.Html.HtmlTag
type Node = Stdlib.Html.Node

let nodeToString (node: Node) : String = Stdlib.Html.nodeToString node

let stringNode (str: String) : Node = Stdlib.Html.stringNode str

let htmlTag (n: String) (a: List<String * String>) (c: List<Node>) : Node =
Stdlib.Html.htmlTagNode n a c


let tidyHtml (html: String) : String =
html
|> Stdlib.String.split "\n"
|> Stdlib.List.map (fun line -> Stdlib.String.trim line)
|> Stdlib.String.join ""


// -- basic testing of low-level fns
(htmlTag "div" [] []) |> nodeToString = "<div/>"

(htmlTag "div" [] [ stringNode "yolo" ]) |> nodeToString = "<div>yolo</div>"

(htmlTag "div" [ ("id", "my-div") ] [ stringNode "yolo" ]) |> nodeToString = "<div id=\"my-div\">yolo</div>"

(htmlTag "div" [] [ htmlTag "button" [] [ stringNode "click me" ] ])
|> nodeToString = "<div><button>click me</button></div>"


// -- testing of simple html node helpers
(Stdlib.Html.comment "hello") |> nodeToString = "<!-- hello -->"

(Stdlib.Html.br ()) |> nodeToString = "<br/>"
(Stdlib.Html.div [] []) |> nodeToString = "<div/>"
(Stdlib.Html.span [] []) |> nodeToString = "<span/>"

(Stdlib.Html.h1 [] []) |> nodeToString = "<h1/>"
(Stdlib.Html.h2 [] []) |> nodeToString = "<h2/>"
(Stdlib.Html.h3 [] []) |> nodeToString = "<h3/>"
(Stdlib.Html.h4 [] []) |> nodeToString = "<h4/>"
(Stdlib.Html.h5 [] []) |> nodeToString = "<h5/>"
(Stdlib.Html.h6 [] []) |> nodeToString = "<h6/>"

(Stdlib.Html.p [] []) |> nodeToString = "<p/>"
(Stdlib.Html.ul [] []) |> nodeToString = "<ul/>"
(Stdlib.Html.ol [] []) |> nodeToString = "<ol/>"
(Stdlib.Html.li [] []) |> nodeToString = "<li/>"

(Stdlib.Html.table [] []) |> nodeToString = "<table/>"
(Stdlib.Html.tr [] []) |> nodeToString = "<tr/>"
(Stdlib.Html.td [] []) |> nodeToString = "<td/>"
(Stdlib.Html.th [] []) |> nodeToString = "<th/>"
(Stdlib.Html.tbody [] []) |> nodeToString = "<tbody/>"
(Stdlib.Html.thead [] []) |> nodeToString = "<thead/>"
(Stdlib.Html.tfoot [] []) |> nodeToString = "<tfoot/>"

(Stdlib.Html.caption [] []) |> nodeToString = "<caption/>"

(Stdlib.Html.colgroup [] []) |> nodeToString = "<colgroup/>"
(Stdlib.Html.col [] []) |> nodeToString = "<col/>"


// -- test writing out a full document

([ Stdlib.Html.html
[]
[ Stdlib.Html.head [] [ Stdlib.Html.title [] [ stringNode "Darklang.com" ] ]

Stdlib.Html.body [] [ Stdlib.Html.p [] [ stringNode "welcome to darklang" ] ] ] ]
|> Stdlib.Html.document) = ("<!DOCTYPE html>
<html>
<head><title>Darklang.com</title></head>
<body><p>welcome to darklang</p></body>
</html>"
|> tidyHtml)
155 changes: 155 additions & 0 deletions packages/darklang/stdlib/html.dark
Original file line number Diff line number Diff line change
@@ -0,0 +1,155 @@
module Darklang =
module Stdlib =

/// TODO think more on the organization of these
/// - should the 'tag' helpers be in some Tag submodule?
/// - should nodeToString be in a Node module, with HtmlTag and Node moved there?
///
/// TODO fill in more helpers for common HTML tags
module Html =
type HtmlTag =
{ name: String
attrs: List<String * String>
children: List<Node> }

type Node =
/// for comments and when we don't want to write something out in Dark-y HTML
| String of String
| HtmlTag of HtmlTag


let stringNode (str: String) : Node = Node.String str

let htmlTagNode
(name: String)
(attrs: List<String * String>)
(children: List<Node>)
: Node =
(HtmlTag
{ name = name
attrs = attrs
children = children })
|> Node.HtmlTag


let nodeToString (node: Node) : String =
match node with
| String str -> str
| HtmlTag tag ->
let attributesText =
tag.attrs
|> List.map (fun (key, value) -> $"{key}=\"{value}\"")
|> String.join " "

match tag.children with
| [] ->
match attributesText with
| "" -> $"<{tag.name}/>"
| text -> $"<{tag.name} {text}/>"

| children ->
let childHtml =
children |> List.map (fun c -> Html.nodeToString c) |> String.join ""

let startTag =
match attributesText with
| "" -> $"<{tag.name}>"
| text -> $"<{tag.name} {text}>"

let endTag = $"</{tag.name}>"

startTag ++ childHtml ++ endTag


let comment (s: String) : Node = stringNode $"<!-- {s} -->"

let br () : Node = htmlTagNode "br" [] []

let html (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "html" attrs c

let body (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "body" attrs c

let head (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "head" attrs c

let title (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "title" attrs c

let a (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "a" attrs c

// same for div, span, etc.:
let div (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "div" attrs c

let span (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "span" attrs c

let h1 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h1" attrs c

let h2 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h2" attrs c

let h3 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h3" attrs c

let h4 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h4" attrs c

let h5 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h5" attrs c

let h6 (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "h6" attrs c

let p (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "p" attrs c

let ul (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "ul" attrs c

let ol (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "ol" attrs c

let li (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "li" attrs c

let table (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "table" attrs c

let tr (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "tr" attrs c

let td (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "td" attrs c

let th (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "th" attrs c

let tbody (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "tbody" attrs c

let thead (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "thead" attrs c

let tfoot (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "tfoot" attrs c

let caption (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "caption" attrs c

let colgroup (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "colgroup" attrs c

let col (attrs: List<String * String>) (c: List<Node>) : Node =
htmlTagNode "col" attrs c



let document (nodes: List<Node>) : String =
let htmlDocHeader = "<!DOCTYPE html>"
let theRest = nodes |> List.map (fun n -> nodeToString n) |> String.join ""
htmlDocHeader ++ theRest
152 changes: 0 additions & 152 deletions scripts/deployment/sync-packages-and-canvases.dark

This file was deleted.

0 comments on commit a68b808

Please sign in to comment.