Adds first working version

README.md

@@ -1 +1,236 @@
-# guile-markup
+# Guile Markup
+
+A Guile module that makes it easy to generate HTML markup.
+
+## Usage
+
+### Creating a single element:
+
+The `markup-el` procedure provides an easy way to create HTML elements.
+It actually does a fair bit more, but for now lets focus on the creation of
+single HTML elements.
+
+You can control the type of the element by using the `#:type` argument, it can
+be either `sc` (self closing) or `void`. It's also important to note, that the
+first string argument will be escaped and obviously its not intended to contain
+any HTML.
+
+<sub>Guile</sub>
+
+```scheme
+(markup-el "div")               ;; Default element.
+(markup-el "img" #:type 'sc)    ;; Self closing element
+(markup-el "meta" #:type 'void) ;; Void element
+```
+
+<sub>Result</sub>
+
+```HTML
+<div></div>
+<img/>
+<meta>
+```
+
+### Adding attributes to an element:
+
+To add attributes to an element you can use the `#:attrs` argument, it takes a
+list of string pairs `("key" . "value")`, a list of strings or a mixture of the
+two. Attribute keys and values will be escaped, aside for the values of
+attributes that allow JavaScript.
+
+Here's a list of these attributes:
+
+- `onclick`
+- `onload`
+- `onchange`
+- `onsubmit`
+- `onmouseover`
+- `onkeydown`
+- `href`
+
+<sub>Guile</sub>
+
+```scheme
+(markup-el "div" #:attrs '(("id" . "sample-id")))
+(markup-el "textarea" #:attrs '("disabled"))
+(markup-el "img" #:type 'sc #:attrs '(("src" . "https://example.com/cat.jpg")))
+(markup-el "meta" #:type 'void #:attrs '(("charset" . "UTF-8")))
+```
+
+<sub>Result</sub>
+
+```HTML
+<div id="sample-id"></div>
+<textarea disabled></textarea>
+<img src="https://example.com/cat.jpg"/>
+<meta charset="UTF-8">
+```
+
+### Adding content to an element:
+
+The `inner` argument can take a string or a list of child elements, but we'll
+look at adding inner elements later. For now when the `inner` argument is given
+a string, it will use it as the inner text. By default the given string will
+always be escaped.
+
+If you want to inject a raw string, you can do so using the `inner!` argument,
+it onlt accepts a string and will not perform any escaping.
+
+<sub>Guile</sub>
+
+```scheme
+(markup-el "div" #:inner "This is my inner text.")
+(markup-el "div" #:inner "<span>Inner text that contains HTML will be escaped.</span>")
+(markup-el "div" #:inner! "<span>Using inner! can be risky, take care, no escaping here.</span>")
+```
+
+<sub>Result</sub>
+
+```HTML
+<div>This is my inner text.</div>
+<div>&lt;span&gt;Inner text that contains HTML will be escaped.&lt;/span&gt;</div>
+<div><span>Using inner! can be risky, take care, no escaping here.</span></div>
+```
+
+### Adding child elements:
+
+As stated earlier, the `inner` argument can also take a list of list of
+arguments. These inner argument lists will be recursively applied to the
+`markup-el` procedure. This means that each of the inner quoted list can contain
+any of the arguments accepted by the `markup-el` method.
+
+<sub>Guile</sub>
+
+```scheme(
+(markup-el "div" #:attrs '(("id" . "colors"))
+           #:inner '(("div" #:inner "Red")
+                     ("div" #:inner "Blue")
+                     ("div" #:inner "Green")))
+```
+
+<sub>Result</sub>
+
+```HTML
+<div id="colors">
+  <div>Red</div>
+  <div>Blue</div>
+  <div>Green</div>
+</div>
+```
+
+### Creating multiple elements at once:
+
+There's also a helper method available `markup-els` for situations where you
+would like to create multiple elements at the root level, meaning, without being
+wrapped in a parent node. This procedure has one required argument and that is a
+list of argument lists. It also accepts a `lvl` argument at the end, that we'll
+discuss next.
+
+<sub>Guile</sub>
+
+```scheme(
+(markup-els
+ '(("div" #:inner "A")
+   ("div" #:inner "B")
+   ("div" #:inner "C")
+   ("div" #:inner "D")
+   ("div" #:inner "E")))
+```
+
+<sub>Result</sub>
+
+```HTML
+<div>A</div>
+<div>B</div>
+<div>C</div>
+<div>D</div>
+<div>E</div>
+```
+
+### Controlling indentations
+
+If you care about indentations, you'll be happy to know that you do have some
+control over it. The first thing you can do is set the indentation size using
+`set-indentation-size`. The default indentation size is `2`.
+
+<sub>Guile</sub>
+```scheme
+(markup-el "div"
+           #:inner '(("div" #:inner "Red")
+                     ("div" #:inner "Blue")
+                     ("div" #:inner "Green")))
+
+;; Sets the global indentation size.
+(set-indentation-size 4)
+
+(markup-el "div"
+           #:inner '(("div" #:inner "Red")
+                     ("div" #:inner "Blue")
+                     ("div" #:inner "Green")))
+```
+
+```html
+<!-- Uses the default indentation size. -->
+<div>
+  <div>Red</div>
+  <div>Blue</div>
+  <div>Green</div>
+</div>
+
+<!-- This one uses our updated indentation size. -->
+<div>
+    <div>Red</div>
+    <div>Blue</div>
+    <div>Green</div>
+</div>
+```
+
+In addition to the `set-indentation-size` helper, you can also specify the
+indentation level of each element using the `#:lvl` argument. The level argument
+allows you to shift an element and its children up or down. A level is absically this
+`indentation-size * lvl`.
+
+```scheme
+(markup-el "div" #:lvl 5
+           #:inner '(("div" #:inner "Red")
+                     ("div" #:inner "Blue")
+                     ("div" #:inner "Green")))
+```
+
+```html
+<!-- Shifted up 5 times the indentation size. -->
+          <div>
+            <div>Red</div>
+            <div>Blue</div>
+            <div>Green</div>
+          </div>
+```
+
+### HTML document example
+
+Here's an example of a default HTML5 document's markup.
+
+```scheme
+(markup-els
+  '(("!DOCTYPE" #:type 'void #:attrs ("html"))
+    ("html" #:attrs (("lang" . "en"))
+     #:inner
+     (("head"
+       #:inner (("meta" #:type 'void #:attrs (("charset" . "UTF-8")))
+                ("meta" #:type 'sc #:attrs (("name" . "viewport")
+                                            ("content" . "width=device-width, initial-scale=1.0")))
+                ("title" #:inner "My Page Title")))
+      ("body" #:inner "Hello World")))))
+```
+
+```html
+<!DOCTYPE html>
+<html lang="en">
+  <head>
+    <meta charset="UTF-8">
+    <meta name="viewport" content="width=device-width, initial-scale=1.0">
+    <title>My Page Title</title>
+  </head>
+  <body>Hello World</body>
+</html>
+```

markup.scm

@@ -0,0 +1,113 @@
+(define-module (markup)
+  #:export (markup
+            markup-el
+            set-indentation-size))
+
+(use-modules
+ (markup helpers)
+ (markup escape)
+ (ice-9 match)
+ (srfi srfi-37))
+
+;;;;;;;;;;;;;;
+;; Internal ;;
+;;;;;;;;;;;;;;
+
+(define indentation-size 2)
+
+(define (set-indentation-size num)
+  (set! indentation-size num))
+
+(define* (opening-tag tag #:key (attrs '()) (type 'default) (lvl 0))
+  "Builds the elements opening tag.
+ATTRS: A list of pairs and or strings. Pairs will be used to construct basic
+element attributes, while strings will be used as stand along attributes, for
+example the `disabled` attribute used on form elements."
+
+  (define (attr-supports-js? str)
+    (member str '("onclick",
+                  "onload",
+                  "onchange",
+                  "onsubmit",
+                  "onmouseover",
+                  "onkeydown",
+                  "href")))
+
+  (define (attrs->ls-str x)
+    (match x
+      ((? pair-strings?)
+       (let* ((key (string-trim-both (car x)))
+              (val (string-trim-both (cdr x)))
+              (key-escaped (escape-html key))
+              (val-escaped (if (attr-supports-js? key)
+                               (escape-js val)
+                               (escape-html val))))
+         (string-append key-escaped "=" "\"" val-escaped "\"")))
+      ((? string?)
+       (escape-html (string-trim-both x)))
+      (_ "")))
+
+  (let* ((tag-prepared (escape-html (string-trim-both tag)))
+         (attrs? (not (null? attrs)))
+         (attrs-str (if attrs?
+                        (string-append " " (string-join (map attrs->ls-str attrs) " "))
+                        ""))
+         (ot (cond
+              ((equal? type 'sc) (format #f "<~a~a~a>" tag-prepared attrs-str "/"))
+              (else (format #f "<~a~a>" tag-prepared attrs-str)))))
+    (string-pad ot (+ (* lvl indentation-size) (string-length ot)))))
+
+(define* (closing-tag tag #:key (lvl 0) (type 'default))
+  "Builds the elements closing tag."
+  (let* ((tag-prepared (escape-html (string-trim-both tag)))
+         (ct (format #f "</~a>" tag-prepared)))
+    (cond
+     ((equal? type 'default)
+      (string-pad ct (+ (* lvl indentation-size) (string-length ct))))
+     (else ""))))
+
+;;;;;;;;;;;;;
+;; Library ;;
+;;;;;;;;;;;;;
+
+(define* (markup-el tag #:key (attrs '()) (inner "") (type 'default) (void #f) (sc #f) (lvl 0) (inner! #f))
+  "Creates a single HTML element with optional children."
+
+  (define (maybe-append-lvl ls lvl)
+    (let ((lvl-exists? (member '#:lvl ls)))
+      (if lvl-exists? ls (append ls `(#:lvl ,lvl)))))
+
+  (define (inner-builder inner lvl)
+    (let* ((inner-with-lvls (map (lambda (ls) (maybe-append-lvl ls lvl)) inner))
+           (inner->str-ls (map (lambda (ls) (apply markup-el ls)) inner-with-lvls)))
+      (string-append "\n" (string-join inner->str-ls "\n") "\n")))
+
+  (if (not inner!)
+      (match inner
+        ((? list?)
+         (string-append (opening-tag tag #:attrs attrs #:lvl lvl)
+                        (inner-builder inner (+ lvl 1))
+                        (closing-tag tag #:lvl lvl)))
+
+        ((? string?)
+         (string-append (opening-tag tag #:attrs attrs #:lvl lvl #:type type)
+                        (if (equal? type 'default) (escape-html inner) "")
+                        (closing-tag tag #:type type)))
+
+        (_ (string-append (opening-tag tag #:attrs attrs #:lvl lvl #:type type)
+                          (closing-tag tag #:type type))))
+
+      ;; Raw inner strings:
+      (string-append (opening-tag tag #:attrs attrs #:lvl lvl #:type type)
+                     (if (equal? type 'default) inner! "")
+                     (closing-tag tag #:type type))))
+
+(define* (markup-els inner #:key (lvl 0))
+  "Creates html elements at root level."
+  (define (maybe-append-lvl ls lvl)
+    (let ((lvl-exists? (member '#:lvl ls)))
+      (if lvl-exists? ls (append ls `(#:lvl ,lvl)))))
+
+  (let* ((inner-with-lvls (map (lambda (ls) (maybe-append-lvl ls lvl)) inner))
+         (inner->str-ls (map (lambda (ls) (apply markup-el ls)) inner-with-lvls)))
+    (string-join inner->str-ls "\n")))

markup/escape.scm

@@ -0,0 +1,27 @@
+(define-module (markup escape)
+  #:export (escape-html
+            escape-js))
+
+(define (escape-html str)
+  (define (escape str)
+    (map (lambda (c)
+           (case c
+             ((#\&) "&")
+             ((#\") """)
+             ((#\<) "&lt;")
+             ((#\>) "&gt;")
+             ((#\') "&#39;")
+             (else (string c))))
+         (string->list str)))
+  (let ((str-escaped (escape str)))
+    (string-join str-escaped "")))
+
+(define (escape-js str)
+  (define (escape str)
+    (map (lambda (c)
+           (case c
+             ((#\") "\\\"")
+             (else (string c))))
+         (string->list str)))
+  (let ((str-escaped (escape str)))
+    (string-join str-escaped "")))

markup/helpers.scm

@@ -0,0 +1,9 @@
+(define-module (markup helpers)
+  #:export (pair-strings?))
+
+(define (pair-strings? x)
+  "Return true, when both elements in a pair is of string type."
+  (if (pair? x)
+      (and (string? (car x))
+           (string? (cdr x)))
+      #f))