I have a confession to make: I really hate writing boilerplate code.
I use Apache to serve lots of websites, have many lines of configuration code and have often longed for a way to capture all the patterns and reduce code duplication. I thought about using a macro language like m4 or the C preprocessor or even Ruby but neither alternative was particulary attractive. Then it hit me that I could describe the Apache configuration with plain
(group (VirtualHost *) (ServerName www.defsoftware.se) (RedirectPermanent / http://defsoftware.se/))
Racket—being a Lisp equipped with many powerful built-in functions—makes a full translator for these kind of trees simple to write.
(require scribble/text) (define (apache-config . complete-config) (define (format-apache-config config) (match config ((list 'group (list group ...) directives ...) (list "<" (add-between group " ") ">" "\n" " " (add-newlines (map format-apache-config directives)) "\n" "</" (first group) ">")) ((list (list _ ...) ...) (add-newlines (map format-apache-config config))) ((list _ ...) (add-between config " ")))) (output (format-apache-config complete-config)) (newline))
output function takes care of the indentation in a pretty clever way.
apache-config—we can start building functions that work with Apache S-expressions:
(define (host-redirect from-hostname to-hostname) `(group (VirtualHost *) (ServerName ,from-hostname) (RedirectPermanent / ,(string-append "http://" to-hostname "/")))) (apache-config (host-redirect "defsoftware.com" "defsoftware.se") (host-redirect "defsoftware.net" "defsoftware.se"))
<VirtualHost *> ServerName defsoftware.com RedirectPermanent / http://defsoftware.se/ </VirtualHost> <VirtualHost *> ServerName defsoftware.net RedirectPermanent / http://defsoftware.se/ </VirtualHost>
Now I’m happy.
(define (apache-config . config) (let self ((config-fragment config) (indent 0)) (define (line-with-indent . args) (display (make-string (* 2 indent) #\ )) (apply printf args) (newline)) (define (join xs (sep " ")) (string-join (map (curry format "~a") xs) sep)) (match config-fragment ((list) (void)) ((list (list nested ...) more ...) (self nested indent) (self more indent)) ((list 'group (list group ...) directives ...) (line-with-indent "<~a>" (join group)) (self directives (add1 indent)) (line-with-indent "</~a>" (first group))) ((list (or (? string?) (? symbol?)) ...) (line-with-indent (join config-fragment))))))