make distribution by default

[rrq/hourglass.git] / manager / expand-string.lsp

;; @module expand-string.lsp
;; @author Ralph Ronnquist, Real Thing Entertainment Pty. Ltd.
;; @location http://www.realthing.com.au/files/newlisp/expand-string.lsp
;; @version 1.3, 2015-09-14 Added markdown blocks
;; @version 1.2, 2015-08-22
;; @description Inclusion module providing string templating using expansion.
;
;; This is an inclusion module that provides an <expand-string>
;; function to process a string template and replace key tokens as
;; declared in a rules list of token-to-replacement associations with
;; their associated values. It offers a similar function to <expand>,
;; but for strings, and using string pattern match without
;; tokenization to determine the replacement points. Further, it
;; evaluates the rule value parts to make the replacements.
;;
;; The <expand-string> module was developed as a means to separate
;; logic and rendering in newlisp CGI scripting, and thereby
;; facilitate a higher degree of modularisation, in the aim of
;; increasing the maintainability.  It supports the design principle
;; where the handling of a request is directed to a newlisp "logic
;; script" that implements the request logic, and finishes by response
;; rendering via an <expand-file> call.
;;
;; By virtue of the replacement value evaluation, the response
;; rendering is more than a substitution of keywords. Rather it
;; selectively transitions back into newlisp evaluation, e.g., to pick
;; up particulars from the logic context, and transform and combine
;; them for rendering purposes.
;;
;; This makes it easy to achieve a consistent appearance across all
;; response pages, by sharing inclusion fragments. For example,
;; response templates may include a common ingress fragment, common
;; component fragments, and a common egress fragment. Such fragments
;; may be included generically by using &lt;?newlisp ?&gt; or
;; &lt;EVAL&gt;..&lt;/EVAL&gt; phrases to invoke <expand-file> for the
;; inclusion fragments, or it may be done specifically by special
;; replacement rules.
;
;; <hr/>
;
;; @syntax (expand-string <text> <rules>)
;; The <expand-string> function processes the given text for the
;; occurrences of the rule keys, and replaces these with the values
;; obtained by evaluating the associated value expressions. The result
;; is the new string with replacements. Note that a value expression
;; may affect variable <txt>, which is the rest of the input following
;; the expanding key, to optionally consume additional text in the
;; replacement. See function <.expand-map> for an example.
;
;; @syntax (expand-file file rules)
;; The <expand-file> function reads the file and expand it using
;; <expand-string> with the rules.
;
;; @syntax (.expand-eval <ctx> <end>)
;; This function is intended as expansion value function for an
;; <expand-string> rule, to implement template expression
;; evaluation. The <ctx> parameter tells the context for symbol
;; creations. The optional <end> parameter tells the end of the
;; replacement fragment. This function extracts the text fragment
;; until the nearest <end> text, then evaluates this with
;; <eval-string>, makes the result a string, and uses that as value to
;; replace the whole block. See <default-expand-rules> below how a
;; rule using this function may look.
;
;; @syntax (.expand-cond <ctx> <mid> <end>)
;;
;; This function is intended as an expansion value function for an
;; <expand-string> rule, to implement template fragment conditional
;; cascade. The optional <mid> parameter tells the pattern that
;; divides the cascaded parts, which is "&lt;ELSEIF/&gt;" by default,
;; and the optional <end> parameter tells the end of the whole cascade
;; fragment, which is "&lt;/IF&gt;" by default. Note that the <mid>
;; pattern is a divider between the conditional parts. and thereby
;; both the end of the preceding part, and the beginning of the
;; succeeding part.
;;
;; The cascaded parts are processed in order, for selecting one to
;; include and expand recursively. To this end, each part starts with
;; an s-expression, that gets evaluated to determine whether the part
;; should be included or not. If the value is nil, the the part is
;; ignored, and the processing continues with the next part. If the
;; value is non-nil, the rest of the part is expanded recursively via
;; <expand-string>, and this is then returned as the expansion result
;; of the cascade. If none of the parts is selected, the cascade
;; expansion results in the empty string.
;
;; @syntax (.expand-map <ctx> <end>)
;; This function is intended as expansion value function for an
;; <expand-string> rule, to implement template fragment
;; repetition. The optional <ctx> parameter tells the context for
;; symbol creations. The optional <end> parameter tells the end of the
;; fragment portion, which is "&lt;/MAP&gt;" by default. The function
;; pulls two s-expression from the template using <read-expr>. The
;; first is a list of keys, and the second a list of binding lists for
;; those keys. The rest of the fragment is then expanded recursively,
;; repeatedly, with the keys having their subsequent bindings, and the
;; block is replaced by the concatenation of these results. See
;; <default-expand-rules> below how a rule using this function may
;; look.
;
;; @syntax (.expand-markdown <ctx> <end>)
;
;; This function is intended as expansion value function for an
;; <expand-string> rule, to implement template fragment markdown
;; processing. It first passes the fragment for recursive
;; expand-string processing, the uses the
;; @link http://daringfireball.net/projects/markdown markdown
;; program to translate the fragment into html.
;
;; @syntax (mapv <name>)
;; This is a utility macro to both lookup a name in the current rules,
;; and bind its value as the value for that variable. This is
;; typically used for referring to a &lt;MAP&gt; variable.
;
;; @syntax default-expand-rules
;; This constant holds a few default rules for using repetition end
;; expression evaluation. Currently set to the following:
;; <pre>
;; (constant 'default-expand-rules
;;           '(("&lt;MAP1&gt;" (.expand-map MAIN "&lt;/MAP1&gt;"))
;;             ("&lt;MAP2&gt;" (.expand-map MAIN "&lt;/MAP2&gt;"))
;;             ("&lt;MAP3&gt;" (.expand-map MAIN "&lt;/MAP3&gt;"))
;;             ("&lt;MAP&gt;" (.expand-map MAIN "&lt;/MAP&gt;"))
;;             ("&lt;EVAL&gt;" (.expand-eval MAIN "&lt;/EVAL&gt;"))))
;;             ("&lt;?newlisp" (.expand-eval MAIN "?&gt;"))
;;             ("&lt;markdown&gt;" (.expand-eval MAIN "&lt;/markdown&gt;"))
;;            ))
;; </pre> These default rules obviously favours HTML templates.
;;
;; <center>&sect;</center>
;; <h2>Examples</h2>
;; <b>Example:</b> The following is an illustration of <expand-string>
;; using <.expand-map>:
;; <pre>(expand-string
;;          "&lt;MAP&gt;(A B) '((1 2) (3 4)) A B B A&lt;/MAP&gt;"
;;          '(("&lt;MAP&gt;" (.expand-map)) ))
;; </pre>
;; The example results in the string " 1 2 2 1 3 4 4 3".
;;
;; Note that the binding lists expression is evaluated in the given
;; context, or MAIN, if nil is given. Thus, the rule above is
;; equivalent with the following: <tt>(.expand-map MAIN "&lt;/MAP&gt;")</tt>
;;
;; Note also that the fragment blocks cannot be nested. To achieve
;; nested repetition, use several tag pairs, as in the following rule set:
;; <pre> '(("&lt;MAP1&gt;" (.expand-map nil "&lt;/MAP1&gt;"))
;;   ("&lt;MAP2&gt;" (.expand-map nil "&lt;/MAP2&gt;"))
;;   ("&lt;MAP3&gt;" (.expand-map nil "&lt;/MAP3&gt;")) )</pre>
;; In that case, the outer expansion keys may be used in the inner
;; repetition although they are not actually bound to the values.
;;
;; <b>Example:</b>
;; <pre>(expand-string
;;          {&lt;EVAL&gt;(first (exec "uname -mrs"))&lt;/EVAL&gt;}
;;          default-expand-rules )</pre>
;; This example results in the machine details as reported by the
;; <uname> program with the <-mrs> command line argument.
;;
;; <b>Example:</b> This example illustrates HTML rendering, with a
;; template file that includes certain keys for expansion. In this
;; case I have a list if paragraps as value of variable <texts>, and
;; want them inserted nicely into an HTML page. Note that the spaces
;; following the two s-expressions in the &lt;MAP&gt;..&lt;/MAP&gt;
;; construct are compulsory, and they get consumed by the <read-expr>
;; function.
;
;; <pre> @PAGEDOCTYPE@
;; &lt;html&gt;&lt;head&gt;&lt;title&gt;@TITLE@&lt;/title&gt;&lt;/head&gt;
;; &lt;body&gt;&lt;h1&gt;@TITLE@&lt;/h1&gt;
;; &lt;MAP&gt;(text) texts &lt;p&gt;text&lt;/p&gt;&lt;/MAP&gt;
;; &lt;/body&gt;&lt;/html&gt;</pre>
;
;; This template would be used in a context that provides suitable
;; expansion rules for the "@PAGEDOCTYPE@" and "@TITLE@" keys, as well
;; as the default "&lt;MAP&gt;" expansion rule.
;;
;; <b>Example:</b> This example illustrates the use of a conditional
;; cascade template fragment. It expands to one of the sentences
;; depending on the conditions.
;;
;; <pre> &lt;IF&gt; (&gt; (setf cnt (length (index fresh strawberries))) 10)
;; Mostly fresh strawberries.
;; &lt;ELSEIF/&gt; (&gt; cnt 5) Many strawberries are fresh.
;; &lt;ELSEIF/&gt; (&gt; cnt) At least some strawberries are fresh.
;; &lt;ELSEIF/&gt; true None of the strawberries are fresh.
;; &lt;/IF&gt;</pre>
;
;; Thus in the example, if the list <strawberries> has more than 10
;; elements qualified as <fresh>, then the expansion is "Mostly fresh
;; strawberries.". As a side effect, the count is cached by the first
;; evaluation, regardless of the value, and this is then used in the
;; subsequent expressions.
;;
;; <b>Example:</b> This example illustrates the use of a markdown,
;; where the template is somewhat more readable.
;; <pre>
;; &lt;markdown&gt;
;; # This is a H1 header<br>
;; A first paragraph.<br>
;; ## Then a H2 header<br>
;; And a second paragraph with [this link](http://www.realthing.com.au) to somewhere.<br>
;; * A list item
;; * and another list item
;;   1. with a numbered sub item in the item
;;   1. and a second sub item<br>
;; and so on...
;; &lt;/markdown&gt;
;; </pre>
;; Note that the markdown block is expanded recursively before being
;; passed to the markdown processor. Thus, that inner expansion may
;; result in markdown as well as raw HTML (which the markdown
;; processor digests without ado).

############################################################

(define (rule-key rule)
  (replace "[\\?*.()]" (first rule) (string "\\" $it) 0))

(define (expand-string txt (rules default-expand-rules))
  (if (null? rules) txt
    (let ((pat (string "(" (join (map string (map rule-key rules)) "|") ")"))
          (out "") (i 0))
      (while (setf i (find pat txt 0))
        (extend out (0 i txt))
        (setf txt ((+ i (length $1)) txt))
        (extend out (string (eval (lookup $1 rules)))))
      (extend out txt))))

(define (expand-file file (rules default-expand-rules))
  ;(write-line 2 (string "expand-file " file " " rules))
  (expand-string (read-file file) rules))

(define (.expand-map ctx (end "</MAP>")) ; uses txt rules
  (let ((A (map term (read-expr txt (or ctx MAIN) nil 0)))
        (dlist (read-expr txt (or ctx MAIN) nil $count))
        (frag ($count (- (find end txt nil $count) $count) txt))
        (out ""))
    (setf txt ((+ $count (length frag) (length end)) txt))
    (dolist (d (eval dlist))
      (extend out (expand-string frag (extend (map list A d) rules))))
    out))

(define (.expand-eval ctx (end "</EVAL>")) ; uses txt rules
  (let ((frag (0 (find end txt nil 0) txt)))  
    (setf txt ((+ (length frag) (length end)) txt))
    (string (eval-string frag))))

(define (.expand-cond ctx (mid "<ELSEIF/>") (end "</IF>"))
  (let ((frag (0 (find end txt nil 0) txt)) (fi 0) (ti 0) (ex nil) (out ""))
    (setf txt ((+ (length frag) (length end)) txt))
    (while (and (null? ex) (< fi (length frag)))
      (setf ex (read-expr frag (or ctx MAIN) nil fi))
      (setf fi $count)
      (setf ti (or (find mid frag nil fi) (length frag)))
      (if (setf ex (eval ex))
            (setf out (fi (- ti fi) frag))
          (setf fi (+ ti (length mid)))))
    (expand-string out rules)))

; Process a block for markdown after recursive expansion
(define (.expand-markdown ctx end) ; uses <txt>
  (let ((frag (0 (find end txt nil 0) txt)))
    (setf txt ((+ (length frag) (length end)) txt))
    (letn (f (string "/tmp/markdown-" (date-value)))
      (when (exec (format "/usr/bin/markdown --html4tags > %s" f)
                  (expand-string frag rules))
        (read-file f)))))

(constant 'default-expand-rules
          '(("<MAP1>" (.expand-map MAIN "</MAP1>"))
            ("<MAP2>" (.expand-map MAIN "</MAP2>"))
            ("<MAP3>" (.expand-map MAIN "</MAP3>"))
            ("<MAP>" (.expand-map MAIN "</MAP>"))
            ("<EVAL>" (.expand-eval MAIN "</EVAL>"))
            ("<IF>" (.expand-cond MAIN "<ELSEIF/>" "</IF>"))
            ("<?newlisp" (.expand-eval MAIN "?>"))
            ("<markdown>" (.expand-markdown MAIN "</markdown>"))
            ))

(define-macro (mapv name) (set name (lookup (string name) rules)))

(global 'expand-string 'expand-file '.expand-map 'default-expand-rules 'mapv)

"expand-string.lsp"