;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu services configuration)
  #:use-module (guix packages)
  #:use-module (guix records)
  #:use-module (guix gexp)
  #:use-module ((guix utils) #:select (source-properties->location))
  #:autoload   (texinfo) (texi-fragment->stexi)
 </td></tr></table>
<table class='tabs'><tr><td>
<a href='/tracifyjs/about/?h=templatifyjs'>about</a><a href='/tracifyjs/?h=templatifyjs'>summary</a><a href='/tracifyjs/refs/?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>refs</a><a href='/tracifyjs/log/test/node.js?h=templatifyjs'>log</a><a class='active' href='/tracifyjs/tree/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>tree</a><a href='/tracifyjs/commit/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>commit</a><a href='/tracifyjs/diff/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>diff</a></td><td class='form'><form class='right' method='get' action='/tracifyjs/log/test/node.js'>
<input type='hidden' name='h' value='templatifyjs'/><input type='hidden' name='id' value='68497d025877a4f364187c9ce771d863c73fe7f0'/><select name='qt'>
<option value='grep'>log msg</option>
<option value='author'>author</option>
<option value='committer'>committer</option>
<option value='range'>range</option>
</select>
<input class='txt' type='search' size='10' name='q' value=''/>
<input type='submit' value='search'/>
</form>
</td></tr></table>
<div class='path'>path: <a href='/tracifyjs/tree/?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>root</a>/<a href='/tracifyjs/tree/test?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>test</a>/<a href='/tracifyjs/tree/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>node.js</a></div><div class='content'>blob: fc3a14dcfc25548f0e3b41838895cf167d38295c (<a href='/tracifyjs/about/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>about</a>) (<a href='/tracifyjs/plain/test/node.js?h=templatifyjs&amp;id=68497d025877a4f364187c9ce771d863c73fe7f0'>plain</a>)
<table summary='blob content' class='blob'>
<tr><td class='linenumbers'><pre><a id='n1' href='#n1'>1</a>
<a id='n2' href='#n2'>2</a>
<a id='n3' href='#n3'>3</a>
<a id='n4' href='#n4'>4</a>
<a id='n5' href='#n5'>5</a>
<a id='n6' href='#n6'>6</a>
</pre></td>
<td class='lines'><pre><code>var fs = require("fs");

new Function("exports", require("../tools/node").FILES.map(function(file) {
    if (/exports\.js$/.test(file)) file = require.resolve("./exports");
    return fs.readFileSync(file, "utf8");
}).join("\n\n"))(exports);
</code></pre></td></tr></table>
</div> <!-- class=content -->
                         <div class=footer>generated by
                             <a href="https://git.zx2c4.com/cgit/about/">
                                 cgit
                             </a>
                         </div>
                        </div> <!-- id=cgit -->
</body>
</html>
ybe-stem?          (id #'stem #'maybe- #'stem #'?))
            (serialize-stem       (id #'stem #'serialize- #'stem))
            (serialize-maybe-stem (id #'stem #'serialize-maybe- #'stem)))
         #'(begin
             (define (maybe-stem? val)
               (or (eq? val 'disabled) (stem? val)))
             (define (serialize-maybe-stem field-name val)
               (if (stem? val) (serialize-stem field-name val) ""))))))))

(define-syntax define-configuration
  (lambda (stx)
    (syntax-case stx ()
      ((_ stem (field (field-type def) doc) ...)
       (with-syntax (((field-getter ...)
                      (map (lambda (field)
                             (id #'stem #'stem #'- field))
                           #'(field ...)))
                     ((field-predicate ...)
                      (map (lambda (type)
                             (id #'stem type #'?))
                           #'(field-type ...)))
                     ((field-serializer ...)
                      (map (lambda (type)
                             (id #'stem #'serialize- type))
                           #'(field-type ...))))
           #`(begin
               (define-record-type* #,(id #'stem #'< #'stem #'>)
                 #,(id #'stem #'% #'stem)
                 #,(id #'stem #'make- #'stem)
                 #,(id #'stem #'stem #'?)
                 (%location #,(id #'stem #'-location)
                            (default (and=> (current-source-location)
                                            source-properties->location))
                            (innate))
                 (field field-getter (default def))
                 ...)
               (define #,(id #'stem #'stem #'-fields)
                 (list (configuration-field
                        (name 'field)
                        (type 'field-type)
                        (getter field-getter)
                        (predicate field-predicate)
                        (serializer field-serializer)
                        (default-value-thunk (lambda () def))
                        (documentation doc))
                       ...))
               (define-syntax-rule (stem arg (... ...))
                 (let ((conf (#,(id #'stem #'% #'stem) arg (... ...))))
                   (validate-configuration conf
                                           #,(id #'stem #'stem #'-fields))
                   conf))))))))

(define (serialize-package field-name val)
  "")

;; A little helper to make it easier to document all those fields.
(define (generate-documentation documentation documentation-name)
  (define (str x) (object->string x))
  (define (generate configuration-name)
    (match (assq-ref documentation configuration-name)
      ((fields . sub-documentation)
       `((para "Available " (code ,(str configuration-name)) " fields are:")
         ,@(map
            (lambda (f)
              (let ((field-name (configuration-field-name f))
                    (field-type (configuration-field-type f))
                    (field-docs (cdr (texi-fragment->stexi
                                      (configuration-field-documentation f))))
                    (default (catch #t
                               (configuration-field-default-value-thunk f)
                               (lambda _ '%invalid))))
                (define (show-default? val)
                  (or (string? val) (number? val) (boolean? val)
                      (and (symbol? val) (not (eq? val '%invalid)))
                      (and (list? val) (and-map show-default? val))))
                `(deftypevr (% (category
                                (code ,(str configuration-name)) " parameter")
                               (data-type ,(str field-type))
                               (name ,(str field-name)))
                   ,@field-docs
                   ,@(if (show-default? default)
                         `((para "Defaults to " (samp ,(str default)) "."))
                         '())
                   ,@(append-map
                      generate
                      (or (assq-ref sub-documentation field-name) '())))))
            fields)))))
  (stexi->texi `(*fragment* . ,(generate documentation-name))))