mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 13:36:36 +01:00
guix: toml: Add TOML parser.
* guix/build/toml.scm: New file. * tests/toml.scm: New file. * Makefile.am: Register new files.
This commit is contained in:
Lars-Dominik Braun
Sharlatan Hellseher
parent
eabed5e53d
commit
a163b85444
3 changed files with 922 additions and 0 deletions
|
|
@ -285,6 +285,7 @@ MODULES = \
|
|||
guix/build/qt-utils.scm \
|
||||
guix/build/zig-build-system.scm \
|
||||
guix/build/make-bootstrap.scm \
|
||||
guix/build/toml.scm \
|
||||
guix/search-paths.scm \
|
||||
guix/packages.scm \
|
||||
guix/import/cabal.scm \
|
||||
|
|
@ -605,6 +606,7 @@ SCM_TESTS = \
|
|||
tests/system.scm \
|
||||
tests/style.scm \
|
||||
tests/texlive.scm \
|
||||
tests/toml.scm \
|
||||
tests/transformations.scm \
|
||||
tests/ui.scm \
|
||||
tests/union.scm \
|
||||
|
|
|
|||
478
guix/build/toml.scm
Normal file
478
guix/build/toml.scm
Normal file
|
|
@ -0,0 +1,478 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2023 Lars-Dominik Braun <lars@6xq.net>
|
||||
;;;
|
||||
;;; 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/>.
|
||||
|
||||
;; This is a TOML parser adapted from the ABNF for v1.0.0 from
|
||||
;; https://github.com/toml-lang/toml/blob/1.0.0/toml.abnf
|
||||
;; The PEG grammar tries to follow the ABNF as closely as possible with
|
||||
;; few deviations commented.
|
||||
;;
|
||||
;; The semantics are defined in https://toml.io/en/v1.0.0
|
||||
;; Currently unimplemented:
|
||||
;; - Array of Tables
|
||||
|
||||
(define-module (guix build toml)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 peg)
|
||||
#:use-module (ice-9 textual-ports)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-19)
|
||||
#:use-module (srfi srfi-35)
|
||||
#:export (parse-toml parse-toml-file recursive-assoc-ref &file-not-consumed &already-defined))
|
||||
|
||||
(define-condition-type &toml-error &error toml-error?)
|
||||
(define-condition-type &file-not-consumed &toml-error file-not-consumed?)
|
||||
(define-condition-type &already-defined &toml-error already-defined?)
|
||||
|
||||
;; Overall Structure
|
||||
(define-peg-pattern toml-file body (and expression
|
||||
(* (and ignore-newline expression))))
|
||||
(define-peg-pattern expression body (or
|
||||
(and ws keyval ws (? comment))
|
||||
(and ws table ws (? comment))
|
||||
(and ws (? comment))))
|
||||
|
||||
;; Whitespace
|
||||
(define-peg-pattern ws none (* wschar))
|
||||
(define-peg-pattern wschar body (or " " "\t"))
|
||||
|
||||
;; Newline
|
||||
(define-peg-pattern newline body (or "\n" "\r\n"))
|
||||
;; This newline’s content is ignored, so we don’t need a bunch of (ignore newline).
|
||||
(define-peg-pattern ignore-newline none newline)
|
||||
|
||||
;; Comment
|
||||
(define-peg-pattern non-ascii body (or (range #\x80 #\xd7ff)
|
||||
(range #\xe000 #\x10ffff)))
|
||||
(define-peg-pattern non-eol body (or "\t" (range #\x20 #\x7f) non-ascii))
|
||||
|
||||
(define-peg-pattern comment none (and "#" (* non-eol)))
|
||||
|
||||
;; Key-Value pairs
|
||||
(define-peg-pattern keyval all (and key keyval-sep val))
|
||||
|
||||
(define-peg-pattern key body (or dotted-key
|
||||
simple-key))
|
||||
(define-peg-pattern simple-key all (or quoted-key
|
||||
unquoted-key))
|
||||
(define-peg-pattern unquoted-key body (+ (or (range #\A #\Z)
|
||||
(range #\a #\z)
|
||||
(range #\0 #\9)
|
||||
"-"
|
||||
"_")))
|
||||
(define-peg-pattern quoted-key all (or basic-string
|
||||
literal-string))
|
||||
(define-peg-pattern dotted-key body (and simple-key
|
||||
(+ (and dot-sep simple-key))))
|
||||
(define-peg-pattern dot-sep none (and ws "." ws))
|
||||
(define-peg-pattern keyval-sep none (and ws "=" ws))
|
||||
|
||||
(define-peg-pattern val body (or string
|
||||
boolean
|
||||
array
|
||||
inline-table
|
||||
date-time
|
||||
float
|
||||
integer))
|
||||
|
||||
;; String
|
||||
(define-peg-pattern string all (or ml-basic-string
|
||||
basic-string
|
||||
ml-literal-string
|
||||
literal-string))
|
||||
|
||||
;; Basic String
|
||||
(define-peg-pattern basic-string body (and (ignore "\"")
|
||||
(* basic-char)
|
||||
(ignore "\"")))
|
||||
(define-peg-pattern basic-char body (or basic-unescaped escaped))
|
||||
(define-peg-pattern basic-unescaped body (or wschar
|
||||
"\x21"
|
||||
(range #\x23 #\x5B)
|
||||
(range #\x5D #\x7E)
|
||||
non-ascii))
|
||||
(define-peg-pattern escaped all (and
|
||||
(ignore "\\")
|
||||
(or "\"" "\\" "b" "f" "n" "r" "t"
|
||||
(and (ignore "u")
|
||||
HEXDIG HEXDIG HEXDIG HEXDIG)
|
||||
(and (ignore "U")
|
||||
HEXDIG HEXDIG HEXDIG HEXDIG
|
||||
HEXDIG HEXDIG HEXDIG HEXDIG))))
|
||||
|
||||
;; Multiline Basic String
|
||||
(define-peg-pattern ml-basic-string body (and
|
||||
ml-basic-string-delim
|
||||
(? ignore-newline)
|
||||
ml-basic-body
|
||||
ml-basic-string-delim))
|
||||
(define-peg-pattern ml-basic-string-delim none "\"\"\"")
|
||||
(define-peg-pattern ml-basic-body body (and
|
||||
(* mlb-content)
|
||||
(* (and mlb-quotes (+ mlb-content)))
|
||||
(? mlb-quotes-final)))
|
||||
|
||||
(define-peg-pattern mlb-content body (or mlb-char newline mlb-escaped-nl))
|
||||
(define-peg-pattern mlb-char body (or mlb-unescaped escaped))
|
||||
(define-peg-pattern mlb-quotes body (or "\"\"" "\""))
|
||||
;; We need to convince the parser to backtrack here, thus the additional followed-by rule.
|
||||
(define-peg-pattern mlb-quotes-final body (or (and "\"\"" (followed-by
|
||||
ml-basic-string-delim))
|
||||
(and "\"" (followed-by
|
||||
ml-basic-string-delim))))
|
||||
(define-peg-pattern mlb-unescaped body (or wschar
|
||||
"\x21"
|
||||
(range #\x23 #\x5B)
|
||||
(range #\x5D #\x7E)
|
||||
non-ascii))
|
||||
;; Escaped newlines and following whitespace are removed from the output.
|
||||
(define-peg-pattern mlb-escaped-nl none (and "\\" ws newline
|
||||
(* (or wschar newline))))
|
||||
|
||||
;; Literal String
|
||||
(define-peg-pattern literal-string body (and (ignore "'")
|
||||
(* literal-char)
|
||||
(ignore "'")))
|
||||
(define-peg-pattern literal-char body (or "\x09"
|
||||
(range #\x20 #\x26)
|
||||
(range #\x28 #\x7E)
|
||||
non-ascii))
|
||||
|
||||
;; Multiline Literal String
|
||||
(define-peg-pattern ml-literal-string body (and
|
||||
ml-literal-string-delim
|
||||
(? ignore-newline)
|
||||
ml-literal-body
|
||||
ml-literal-string-delim))
|
||||
(define-peg-pattern ml-literal-string-delim none "'''")
|
||||
(define-peg-pattern ml-literal-body body (and
|
||||
(* mll-content)
|
||||
(* (and mll-quotes (+ mll-content)))
|
||||
(? mll-quotes-final)))
|
||||
|
||||
(define-peg-pattern mll-content body (or mll-char newline))
|
||||
(define-peg-pattern mll-char body (or "\x09"
|
||||
(range #\x20 #\x26)
|
||||
(range #\x28 #\x7E)
|
||||
non-ascii))
|
||||
(define-peg-pattern mll-quotes body (or "''" "'"))
|
||||
;; We need to convince the parser to backtrack here, thus the additional followed-by rule.
|
||||
(define-peg-pattern mll-quotes-final body (or (and "''" (followed-by
|
||||
ml-literal-string-delim))
|
||||
(and "'" (followed-by
|
||||
ml-literal-string-delim))))
|
||||
|
||||
;; Integer
|
||||
(define-peg-pattern integer all (or hex-int oct-int bin-int dec-int))
|
||||
|
||||
(define-peg-pattern digit1-9 body (range #\1 #\9))
|
||||
(define-peg-pattern digit0-7 body (range #\0 #\7))
|
||||
(define-peg-pattern digit0-1 body (range #\0 #\1))
|
||||
(define-peg-pattern DIGIT body (range #\0 #\9))
|
||||
(define-peg-pattern HEXDIG body (or DIGIT
|
||||
(range #\a #\f)
|
||||
(range #\A #\F)))
|
||||
|
||||
(define-peg-pattern dec-int all (and (? (or "-" "+")) unsigned-dec-int))
|
||||
(define-peg-pattern unsigned-dec-int body (or (and digit1-9 (+ (or DIGIT (and (ignore "_") DIGIT))))
|
||||
DIGIT))
|
||||
|
||||
(define-peg-pattern hex-int all (and (ignore "0x")
|
||||
HEXDIG
|
||||
(* (or HEXDIG (and (ignore "_") HEXDIG)))))
|
||||
(define-peg-pattern oct-int all (and (ignore "0o")
|
||||
digit0-7
|
||||
(* (or digit0-7 (and (ignore "_") digit0-7)))))
|
||||
(define-peg-pattern bin-int all (and (ignore "0b")
|
||||
digit0-1
|
||||
(* (or digit0-1 (and (ignore "_") digit0-1)))))
|
||||
|
||||
;; Float
|
||||
(define-peg-pattern float all (or
|
||||
(and float-int-part (or exp (and frac (? exp))))
|
||||
special-float))
|
||||
(define-peg-pattern float-int-part body dec-int)
|
||||
(define-peg-pattern frac body (and "." zero-prefixable-int))
|
||||
(define-peg-pattern zero-prefixable-int body (and DIGIT (* (or DIGIT (and (ignore "_") DIGIT)))))
|
||||
|
||||
(define-peg-pattern exp body (and (or "e" "E") float-exp-part))
|
||||
(define-peg-pattern float-exp-part body (and (? (or "-" "+")) zero-prefixable-int))
|
||||
(define-peg-pattern special-float body (and (? (or "-" "+")) (or "inf" "nan")))
|
||||
|
||||
;; Boolean
|
||||
(define-peg-pattern boolean all (or "true" "false"))
|
||||
|
||||
;; Date and Time (as defined in RFC 3339)
|
||||
|
||||
(define-peg-pattern date-time body (or offset-date-time
|
||||
local-date-time
|
||||
local-date
|
||||
local-time))
|
||||
|
||||
(define-peg-pattern date-fullyear all (and DIGIT DIGIT DIGIT DIGIT))
|
||||
(define-peg-pattern date-month all (and DIGIT DIGIT)) ; 01-12
|
||||
(define-peg-pattern date-mday all (and DIGIT DIGIT)) ; 01-28, 01-29, 01-30, 01-31 based on month/year
|
||||
(define-peg-pattern time-delim none (or "T" "t" " ")) ; T, t, or space
|
||||
(define-peg-pattern time-hour all (and DIGIT DIGIT)) ; 00-23
|
||||
(define-peg-pattern time-minute all (and DIGIT DIGIT)) ; 00-59
|
||||
(define-peg-pattern time-second all (and DIGIT DIGIT)) ; 00-58, 00-59, 00-60 based on leap second rules
|
||||
(define-peg-pattern time-secfrac all (and (ignore ".") (+ DIGIT)))
|
||||
(define-peg-pattern time-numoffset body (and (or "+" "-")
|
||||
time-hour
|
||||
(ignore ":")
|
||||
time-minute))
|
||||
(define-peg-pattern time-offset all (or "Z" time-numoffset))
|
||||
|
||||
(define-peg-pattern partial-time body (and time-hour
|
||||
(ignore ":")
|
||||
time-minute
|
||||
(ignore ":")
|
||||
time-second
|
||||
(? time-secfrac)))
|
||||
(define-peg-pattern full-date body (and date-fullyear
|
||||
(ignore "-")
|
||||
date-month
|
||||
(ignore "-")
|
||||
date-mday))
|
||||
(define-peg-pattern full-time body (and partial-time time-offset))
|
||||
|
||||
;; Offset Date-Time
|
||||
(define-peg-pattern offset-date-time all (and full-date time-delim full-time))
|
||||
|
||||
;; Local Date-Time
|
||||
(define-peg-pattern local-date-time all (and full-date time-delim partial-time))
|
||||
|
||||
;; Local Date
|
||||
(define-peg-pattern local-date all full-date)
|
||||
|
||||
;; Local Time
|
||||
(define-peg-pattern local-time all partial-time)
|
||||
|
||||
;; Array
|
||||
(define-peg-pattern array all (and (ignore "[")
|
||||
(? array-values)
|
||||
(ignore ws-comment-newline)
|
||||
(ignore "]")))
|
||||
|
||||
(define-peg-pattern array-values body (or
|
||||
(and ws-comment-newline
|
||||
val
|
||||
ws-comment-newline
|
||||
(ignore ",")
|
||||
array-values)
|
||||
(and ws-comment-newline
|
||||
val
|
||||
ws-comment-newline
|
||||
(ignore (? ",")))))
|
||||
|
||||
(define-peg-pattern ws-comment-newline none (* (or wschar (and (? comment) ignore-newline))))
|
||||
|
||||
;; Table
|
||||
(define-peg-pattern table all (or array-table
|
||||
std-table))
|
||||
|
||||
;; Standard Table
|
||||
(define-peg-pattern std-table all (and (ignore "[") ws key ws (ignore "]")))
|
||||
(define-peg-pattern array-table all (and (ignore "[[") ws key ws (ignore "]]")))
|
||||
|
||||
;; Inline Table
|
||||
(define-peg-pattern inline-table all (and (ignore "{")
|
||||
(* ws)
|
||||
(? inline-table-keyvals)
|
||||
(* ws)
|
||||
(ignore "}")))
|
||||
(define-peg-pattern inline-table-sep none (and ws "," ws))
|
||||
(define-peg-pattern inline-table-keyvals body (and keyval
|
||||
(? (and inline-table-sep inline-table-keyvals))))
|
||||
|
||||
|
||||
;; Parsing
|
||||
|
||||
(define (recursive-acons key value alist)
|
||||
"Add a VALUE to ALIST of alists descending into keys according to the
|
||||
list in KEY. For instance of KEY is (a b) this would create
|
||||
alist[a][b] = value."
|
||||
(match key
|
||||
(((? string? key))
|
||||
(if (assoc-ref alist key)
|
||||
(raise (condition (&already-defined)))
|
||||
(alist-cons key value alist)))
|
||||
((elem rest ...) (match (assoc-ref alist elem)
|
||||
(#f
|
||||
(acons elem (recursive-acons rest value '()) alist))
|
||||
(old-value
|
||||
(acons elem (recursive-acons rest value old-value) (alist-delete elem alist)))))
|
||||
(() alist)))
|
||||
|
||||
(define (recursive-assoc-ref alist key)
|
||||
"Retrieve a value from ALIST of alists, descending into each value of
|
||||
the list KEY. For instance a KEY (a b) would retrieve alist[a][b]."
|
||||
(match key
|
||||
(((? string? key)) (assoc-ref alist key))
|
||||
((elem rest ...) (recursive-assoc-ref (assoc-ref alist elem) rest))))
|
||||
|
||||
(define (eval-toml-file parse-tree)
|
||||
"Convert toml parse tree to alist."
|
||||
|
||||
(define (assoc-ref->number alist key)
|
||||
(and=> (and=> (assq-ref alist key) car) string->number))
|
||||
|
||||
(define (eval-date rest)
|
||||
(let ((args (keyword-flatten '(date-fullyear
|
||||
date-month
|
||||
date-mday
|
||||
time-hour
|
||||
time-minute
|
||||
time-second
|
||||
time-secfrac
|
||||
time-offset)
|
||||
rest)))
|
||||
(make-date
|
||||
(assoc-ref->number args 'time-secfrac)
|
||||
(assoc-ref->number args 'time-second)
|
||||
(assoc-ref->number args 'time-minute)
|
||||
(assoc-ref->number args 'time-hour)
|
||||
(assoc-ref->number args 'date-mday)
|
||||
(assoc-ref->number args 'date-month)
|
||||
(assoc-ref->number args 'date-fullyear)
|
||||
(match (assq-ref args 'time-offset)
|
||||
(("Z") 0)
|
||||
((sign ('time-hour hour) ('time-minute minute))
|
||||
(* (+
|
||||
(* (string->number (string-append sign hour)) 60)
|
||||
(string->number minute)) 60))
|
||||
(#f #f)))))
|
||||
|
||||
(define (eval-value value)
|
||||
"Evaluate right-hand-side of 'keyval token (i.e., a value)."
|
||||
(match value
|
||||
(('boolean "true")
|
||||
#t)
|
||||
(('boolean "false")
|
||||
#f)
|
||||
(('integer ('dec-int int))
|
||||
(string->number int 10))
|
||||
(('integer ('hex-int int))
|
||||
(string->number int 16))
|
||||
(('integer ('oct-int int))
|
||||
(string->number int 8))
|
||||
(('integer ('bin-int int))
|
||||
(string->number int 2))
|
||||
(('float ('dec-int int) b)
|
||||
(string->number (string-append int b) 10))
|
||||
(('float other)
|
||||
(match other
|
||||
("inf" +inf.0)
|
||||
("+inf" +inf.0)
|
||||
("-inf" -inf.0)
|
||||
("nan" +nan.0)
|
||||
("+nan" +nan.0)
|
||||
("-nan" -nan.0)))
|
||||
(('offset-date-time rest ...)
|
||||
(eval-date rest))
|
||||
(('local-date-time rest ...)
|
||||
(eval-date rest))
|
||||
(('local-date rest ...)
|
||||
(eval-date rest))
|
||||
(('local-time rest ...)
|
||||
(eval-date rest))
|
||||
(('string str ...)
|
||||
(apply string-append
|
||||
(map (match-lambda
|
||||
(('escaped "\"") "\"")
|
||||
(('escaped "\\") "\\")
|
||||
(('escaped "b") "\b")
|
||||
(('escaped "t") "\t")
|
||||
(('escaped "n") "\n")
|
||||
(('escaped (? (lambda (x) (>= (string-length x) 4)) u))
|
||||
(list->string (list (integer->char (string->number u 16)))))
|
||||
((? string? s) s))
|
||||
(keyword-flatten '(escaped) str))))
|
||||
('string "")
|
||||
(('array tails ...)
|
||||
(map eval-value (keyword-flatten '(boolean integer float string array
|
||||
inline-table offset-date-time
|
||||
local-date-time local-date
|
||||
local-time)
|
||||
tails)))
|
||||
('array (list))
|
||||
(('inline-table tails ...)
|
||||
(eval (keyword-flatten '(keyval) tails) '() '()))))
|
||||
|
||||
(define (ensure-list value)
|
||||
(if (list? value)
|
||||
value
|
||||
(list value)))
|
||||
|
||||
(define (simple-key->list keys)
|
||||
(map
|
||||
(match-lambda
|
||||
(('simple-key 'quoted-key) "")
|
||||
(('simple-key ('quoted-key k)) k)
|
||||
(('simple-key (? string? k)) k)
|
||||
(other (raise-exception `(invalid-simple-key ,other))))
|
||||
(keyword-flatten '(simple-key) keys)))
|
||||
|
||||
(define (skip-keyval tails)
|
||||
"Skip key-value pairs in tails until the next table."
|
||||
(match tails
|
||||
((('keyval key val) tails ...)
|
||||
(skip-keyval tails))
|
||||
(('keyval keyval)
|
||||
'())
|
||||
(other other)))
|
||||
|
||||
(define (eval parse-tree current-table result)
|
||||
"Evaluate toml file body."
|
||||
|
||||
(match parse-tree
|
||||
((('table ('std-table names ...)) tails ...)
|
||||
(eval tails (simple-key->list names) result))
|
||||
((('table ('array-table names ...)) tails ...)
|
||||
;; Not implemented.
|
||||
(eval (skip-keyval tails) '() result))
|
||||
((('keyval key val) tails ...)
|
||||
(recursive-acons
|
||||
(append current-table (ensure-list (simple-key->list key)))
|
||||
(eval-value val)
|
||||
(eval tails current-table result)))
|
||||
(('keyval key val)
|
||||
(recursive-acons
|
||||
(append current-table (ensure-list (simple-key->list key)))
|
||||
(eval-value val)
|
||||
result))
|
||||
(()
|
||||
'())))
|
||||
|
||||
(eval parse-tree '() '()))
|
||||
|
||||
(define (parse-toml str)
|
||||
"Parse and evaluate toml document from string STR."
|
||||
|
||||
(let* ((match (match-pattern toml-file str))
|
||||
(end (peg:end match))
|
||||
(tree (peg:tree match))
|
||||
(flat-tree (keyword-flatten '(table keyval) tree)))
|
||||
(if (eq? end (string-length str))
|
||||
(eval-toml-file flat-tree)
|
||||
(raise (condition (&file-not-consumed))))))
|
||||
|
||||
(define (parse-toml-file file)
|
||||
"Parse and evaluate toml document from file FILE."
|
||||
|
||||
(parse-toml (call-with-input-file file get-string-all)))
|
||||
|
||||
442
tests/toml.scm
Normal file
442
tests/toml.scm
Normal file
|
|
@ -0,0 +1,442 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2023 Lars-Dominik Braun <lars@6xq.net>
|
||||
;;;
|
||||
;;; 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 (test-toml)
|
||||
#:use-module (guix build toml)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (srfi srfi-19) ; For datetime.
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
(test-begin "toml")
|
||||
|
||||
;; Tests taken from https://toml.io/en/v1.0.0
|
||||
|
||||
(test-error "parse-toml: Unspecified key"
|
||||
&file-not-consumed
|
||||
(parse-toml "key = # INVALID"))
|
||||
|
||||
(test-error "parse-toml: Missing EOL"
|
||||
&file-not-consumed
|
||||
(parse-toml "first = \"Tom\" last = \"Preston-Werner\" # INVALID"))
|
||||
|
||||
(test-equal "parse-toml: Bare keys"
|
||||
'(("key" . "value") ("bare_key" . "value") ("bare-key" . "value") ("1234" . "value"))
|
||||
(parse-toml "key = \"value\"
|
||||
bare_key = \"value\"
|
||||
bare-key = \"value\"
|
||||
1234 = \"value\""))
|
||||
|
||||
(test-equal "parse-toml: Quoted keys"
|
||||
'(("127.0.0.1" . "value")
|
||||
("character encoding" . "value")
|
||||
("ʎǝʞ" . "value")
|
||||
("key2" . "value")
|
||||
("quoted \"value\"" . "value"))
|
||||
(parse-toml "\"127.0.0.1\" = \"value\"
|
||||
\"character encoding\" = \"value\"
|
||||
\"ʎǝʞ\" = \"value\"
|
||||
'key2' = \"value\"
|
||||
'quoted \"value\"' = \"value\""))
|
||||
|
||||
(test-equal "parse-toml: No key"
|
||||
#f
|
||||
(parse-toml "= \"no key name\""))
|
||||
|
||||
(test-equal "parse-toml: Empty key"
|
||||
'(("" . "blank"))
|
||||
(parse-toml "\"\" = \"blank\""))
|
||||
|
||||
(test-equal "parse-toml: Dotted keys"
|
||||
'(("name" . "Orange")
|
||||
("physical" ("color" . "orange")
|
||||
("shape" . "round"))
|
||||
("site" ("google.com" . #t)))
|
||||
(parse-toml "name = \"Orange\"
|
||||
physical.color = \"orange\"
|
||||
physical.shape = \"round\"
|
||||
site.\"google.com\" = true"))
|
||||
|
||||
(test-equal "parse-toml: Dotted keys with whitespace"
|
||||
'(("fruit" ("name" . "banana") ("color" . "yellow") ("flavor" . "banana")))
|
||||
(parse-toml "fruit.name = \"banana\" # this is best practice
|
||||
fruit. color = \"yellow\" # same as fruit.color
|
||||
fruit . flavor = \"banana\" # same as fruit.flavor"))
|
||||
|
||||
(test-error "parse-toml: Multiple keys"
|
||||
&already-defined
|
||||
(parse-toml "name = \"Tom\"
|
||||
name = \"Pradyun\""))
|
||||
|
||||
(test-equal "parse-toml: Implicit tables"
|
||||
'(("fruit" ("apple" ("smooth" . #t)) ("orange" . 2)))
|
||||
(parse-toml "fruit.apple.smooth = true
|
||||
fruit.orange = 2"))
|
||||
|
||||
(test-error "parse-toml: Write to value"
|
||||
&already-defined
|
||||
(parse-toml "fruit.apple = 1
|
||||
fruit.apple.smooth = true"))
|
||||
|
||||
(test-equal "parse-toml: String"
|
||||
'(("str" . "I'm a string. \"You can quote me\". Name\tJos\u00E9\nLocation\tSF."))
|
||||
(parse-toml "str = \"I'm a string. \\\"You can quote me\\\". Name\\tJos\\u00E9\\nLocation\\tSF.\""))
|
||||
|
||||
(test-equal "parse-toml: Empty string"
|
||||
'(("str1" . "")
|
||||
("str2" . "")
|
||||
("str3" . "")
|
||||
("str4" . ""))
|
||||
(parse-toml "str1 = \"\"
|
||||
str2 = ''
|
||||
str3 = \"\"\"\"\"\"
|
||||
str4 = ''''''"))
|
||||
|
||||
(test-equal "parse-toml: Multi-line basic strings"
|
||||
'(("str1" . "Roses are red\nViolets are blue")
|
||||
("str2" . "The quick brown fox jumps over the lazy dog.")
|
||||
("str3" . "The quick brown fox jumps over the lazy dog.")
|
||||
("str4" . "Here are two quotation marks: \"\". Simple enough.")
|
||||
("str5" . "Here are three quotation marks: \"\"\".")
|
||||
("str6" . "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\".")
|
||||
("str7" . "\"This,\" she said, \"is just a pointless statement.\""))
|
||||
(parse-toml "str1 = \"\"\"
|
||||
Roses are red
|
||||
Violets are blue\"\"\"
|
||||
|
||||
str2 = \"\"\"
|
||||
The quick brown \\
|
||||
|
||||
|
||||
fox jumps over \\
|
||||
the lazy dog.\"\"\"
|
||||
|
||||
str3 = \"\"\"\\
|
||||
The quick brown \\
|
||||
fox jumps over \\
|
||||
the lazy dog.\\
|
||||
\"\"\"
|
||||
|
||||
str4 = \"\"\"Here are two quotation marks: \"\". Simple enough.\"\"\"
|
||||
# str5 = \"\"\"Here are three quotation marks: \"\"\".\"\"\" # INVALID
|
||||
str5 = \"\"\"Here are three quotation marks: \"\"\\\".\"\"\"
|
||||
str6 = \"\"\"Here are fifteen quotation marks: \"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\"\"\"\\\".\"\"\"
|
||||
|
||||
# \"This,\" she said, \"is just a pointless statement.\"
|
||||
str7 = \"\"\"\"This,\" she said, \"is just a pointless statement.\"\"\"\""))
|
||||
|
||||
(test-equal "parse-toml: Literal string"
|
||||
'(("winpath" . "C:\\Users\\nodejs\\templates")
|
||||
("winpath2" . "\\\\ServerX\\admin$\\system32\\")
|
||||
("quoted" . "Tom \"Dubs\" Preston-Werner")
|
||||
("regex" . "<\\i\\c*\\s*>"))
|
||||
(parse-toml "winpath = 'C:\\Users\\nodejs\\templates'
|
||||
winpath2 = '\\\\ServerX\\admin$\\system32\\'
|
||||
quoted = 'Tom \"Dubs\" Preston-Werner'
|
||||
regex = '<\\i\\c*\\s*>'"))
|
||||
|
||||
(test-equal "parse-toml: Multi-line literal strings"
|
||||
'(("regex2" . "I [dw]on't need \\d{2} apples")
|
||||
("lines" . "The first newline is\ntrimmed in raw strings.\n All other whitespace\n is preserved.\n")
|
||||
("quot15" . "Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"")
|
||||
("apos15" . "Here are fifteen apostrophes: '''''''''''''''")
|
||||
("str" . "'That,' she said, 'is still pointless.'"))
|
||||
(parse-toml "regex2 = '''I [dw]on't need \\d{2} apples'''
|
||||
lines = '''
|
||||
The first newline is
|
||||
trimmed in raw strings.
|
||||
All other whitespace
|
||||
is preserved.
|
||||
'''
|
||||
quot15 = '''Here are fifteen quotation marks: \"\"\"\"\"\"\"\"\"\"\"\"\"\"\"'''
|
||||
|
||||
# apos15 = '''Here are fifteen apostrophes: '''''''''''''''''' # INVALID
|
||||
apos15 = \"Here are fifteen apostrophes: '''''''''''''''\"
|
||||
|
||||
# 'That,' she said, 'is still pointless.'
|
||||
str = ''''That,' she said, 'is still pointless.''''"))
|
||||
|
||||
(test-equal "parse-toml: Decimal integer"
|
||||
'(("int1" . 99) ("int2" . 42) ("int3" . 0) ("int4" . -17))
|
||||
(parse-toml "int1 = +99
|
||||
int2 = 42
|
||||
int3 = 0
|
||||
int4 = -17"))
|
||||
|
||||
(test-equal "parse-toml: Decimal integer underscores"
|
||||
'(("int5" . 1000) ("int6" . 5349221) ("int7" . 5349221) ("int8" . 12345))
|
||||
(parse-toml "int5 = 1_000
|
||||
int6 = 5_349_221
|
||||
int7 = 53_49_221 # Indian number system grouping
|
||||
int8 = 1_2_3_4_5 # VALID but discouraged"))
|
||||
|
||||
(test-equal "parse-toml: Hexadecimal"
|
||||
`(("hex1" . ,#xdeadbeef) ("hex2" . ,#xdeadbeef) ("hex3" . ,#xdeadbeef))
|
||||
(parse-toml "hex1 = 0xDEADBEEF
|
||||
hex2 = 0xdeadbeef
|
||||
hex3 = 0xdead_beef"))
|
||||
|
||||
(test-equal "parse-toml: Octal"
|
||||
`(("oct1" . ,#o01234567) ("oct2" . #o755))
|
||||
(parse-toml "oct1 = 0o01234567
|
||||
oct2 = 0o755"))
|
||||
|
||||
(test-equal "parse-toml: Binary"
|
||||
`(("bin1" . ,#b11010110))
|
||||
(parse-toml "bin1 = 0b11010110"))
|
||||
|
||||
(test-equal "parse-toml: Float"
|
||||
'(("flt1" . 1.0)
|
||||
("flt2" . 3.1415)
|
||||
("flt3" . -0.01)
|
||||
("flt4" . 5e+22)
|
||||
("flt5" . 1e06)
|
||||
("flt6" . -2e-2)
|
||||
("flt7" . 6.626e-34)
|
||||
("flt8" . 224617.445991228))
|
||||
(parse-toml "# fractional
|
||||
flt1 = +1.0
|
||||
flt2 = 3.1415
|
||||
flt3 = -0.01
|
||||
|
||||
# exponent
|
||||
flt4 = 5e+22
|
||||
flt5 = 1e06
|
||||
flt6 = -2E-2
|
||||
|
||||
# both
|
||||
flt7 = 6.626e-34
|
||||
|
||||
flt8 = 224_617.445_991_228"))
|
||||
|
||||
(test-equal "parse-toml: Float"
|
||||
'(("sf1" . +inf.0)
|
||||
("sf2" . +inf.0)
|
||||
("sf3" . -inf.0)
|
||||
("sf4" . +nan.0)
|
||||
("sf5" . +nan.0)
|
||||
("sf6" . -nan.0))
|
||||
(parse-toml "# infinity
|
||||
sf1 = inf # positive infinity
|
||||
sf2 = +inf # positive infinity
|
||||
sf3 = -inf # negative infinity
|
||||
|
||||
# not a number
|
||||
sf4 = nan # actual sNaN/qNaN encoding is implementation-specific
|
||||
sf5 = +nan # same as `nan`
|
||||
sf6 = -nan # valid, actual encoding is implementation-specific"))
|
||||
|
||||
(test-equal "parse-toml: Boolean"
|
||||
'(("bool1" . #t)
|
||||
("bool2" . #f))
|
||||
(parse-toml "bool1 = true
|
||||
bool2 = false"))
|
||||
|
||||
(test-equal "parse-toml: Offset date-time"
|
||||
`(("odt1" . ,(make-date #f 0 32 7 27 5 1979 0))
|
||||
("odt2" . ,(make-date #f 0 32 0 27 5 1979 (* -7 60 60)))
|
||||
("odt3" . ,(make-date 999999 0 32 0 27 5 1979 (* 7 60 60)))
|
||||
("odt4" . ,(make-date #f 0 32 7 27 5 1979 0)))
|
||||
(parse-toml "odt1 = 1979-05-27T07:32:00Z
|
||||
odt2 = 1979-05-27T00:32:00-07:00
|
||||
odt3 = 1979-05-27T00:32:00.999999+07:00
|
||||
odt4 = 1979-05-27 07:32:00Z"))
|
||||
|
||||
(test-equal "parse-toml: Local date-time"
|
||||
`(("ldt1" . ,(make-date #f 0 32 7 27 5 1979 #f))
|
||||
("ldt2" . ,(make-date 999999 0 32 0 27 5 1979 #f)))
|
||||
(parse-toml "ldt1 = 1979-05-27T07:32:00
|
||||
ldt2 = 1979-05-27T00:32:00.999999"))
|
||||
|
||||
(test-equal "parse-toml: Local date"
|
||||
`(("ld1" . ,(make-date #f #f #f #f 27 5 1979 #f)))
|
||||
(parse-toml "ld1 = 1979-05-27"))
|
||||
|
||||
(test-equal "parse-toml: Local time"
|
||||
`(("lt1" . ,(make-date #f 0 32 7 #f #f #f #f))
|
||||
("lt2" . ,(make-date 999999 0 32 0 #f #f #f #f)))
|
||||
(parse-toml "lt1 = 07:32:00
|
||||
lt2 = 00:32:00.999999"))
|
||||
|
||||
(test-equal "parse-toml: Arrays"
|
||||
'(("integers" 1 2 3)
|
||||
("colors" "red" "yellow" "green")
|
||||
("nested_arrays_of_ints" (1 2) (3 4 5))
|
||||
("nested_mixed_array" (1 2) ("a" "b" "c"))
|
||||
("string_array" "all" "strings")
|
||||
("numbers" 0.1 0.2 0.5 1 2 5)
|
||||
("contributors" "Foo Bar <foo@example.com>" (("name" . "Baz Qux") ("email" . "bazqux@example.com") ("url" . "https://example.com/bazqux")))
|
||||
("integers2" 1 2 3)
|
||||
("integers3" 1 2))
|
||||
(parse-toml "integers = [ 1, 2, 3 ]
|
||||
colors = [ \"red\", \"yellow\", \"green\" ]
|
||||
nested_arrays_of_ints = [ [ 1, 2 ], [3, 4, 5] ]
|
||||
nested_mixed_array = [ [ 1, 2 ], [\"a\", \"b\", \"c\"] ]
|
||||
string_array = [ \"all\", 'strings' ]
|
||||
|
||||
# Mixed-type arrays are allowed
|
||||
numbers = [ 0.1, 0.2, 0.5, 1, 2, 5 ]
|
||||
contributors = [
|
||||
\"Foo Bar <foo@example.com>\",
|
||||
{ name = \"Baz Qux\", email = \"bazqux@example.com\", url = \"https://example.com/bazqux\" }
|
||||
]
|
||||
|
||||
integers2 = [
|
||||
1, 2, 3
|
||||
]
|
||||
|
||||
integers3 = [
|
||||
1,
|
||||
2, # this is ok
|
||||
]"))
|
||||
|
||||
(test-equal "parse-toml: Tables"
|
||||
'(("table-1" ("key1" . "some string")
|
||||
("key2" . 123))
|
||||
("table-2" ("key1" . "another string")
|
||||
("key2" . 456)))
|
||||
(parse-toml "[table-1]
|
||||
key1 = \"some string\"
|
||||
key2 = 123
|
||||
|
||||
[table-2]
|
||||
key1 = \"another string\"
|
||||
key2 = 456"))
|
||||
|
||||
|
||||
(test-equal "parse-toml: Dotted table"
|
||||
'(("dog" ("tater.man" ("type" ("name" . "pug")))))
|
||||
(parse-toml "[dog.\"tater.man\"]
|
||||
type.name = \"pug\""))
|
||||
|
||||
|
||||
(test-equal "parse-toml: Dotted table with whitespace"
|
||||
'(("a" ("b" ("c" ("x" . 1))))
|
||||
("d" ("e" ("f" ("x" . 1))))
|
||||
("g" ("h" ("i" ("x" . 1))))
|
||||
("j" ("ʞ" ("l" ("x" . 1)))))
|
||||
(parse-toml "[a.b.c] # this is best practice
|
||||
x=1
|
||||
[ d.e.f ] # same as [d.e.f]
|
||||
x=1
|
||||
[ g . h . i ] # same as [g.h.i]
|
||||
x=1
|
||||
[ j . \"ʞ\" . 'l' ] # same as [j.\"ʞ\".'l']
|
||||
x=1"))
|
||||
|
||||
;; XXX: technically this is not allowed, but we permit it.
|
||||
(test-equal "parse-toml: Multiple tables"
|
||||
'(("fruit" ("apple" . "red") ("orange" . "orange")))
|
||||
(parse-toml "[fruit]
|
||||
apple = \"red\"
|
||||
|
||||
[fruit]
|
||||
orange = \"orange\""))
|
||||
|
||||
(test-equal "parse-toml: Assignment to non-table"
|
||||
#f
|
||||
(parse-toml "[fruit]
|
||||
apple = \"red\"
|
||||
|
||||
[fruit.apple]
|
||||
texture = \"smooth\""))
|
||||
|
||||
(test-equal "parse-toml: Dotted keys create tables"
|
||||
'(("fruit" ("apple" ("color" . "red") ("taste" ("sweet" . #t)))))
|
||||
(parse-toml "fruit.apple.color = \"red\"
|
||||
fruit.apple.taste.sweet = true"))
|
||||
|
||||
(test-equal "parse-toml: Inline tables"
|
||||
'(("name" ("first" . "Tom") ("last" . "Preston-Werner"))
|
||||
("point" ("x" . 1) ("y" . 2))
|
||||
("animal" ("type" ("name" . "pug"))))
|
||||
(parse-toml "name = { first = \"Tom\", last = \"Preston-Werner\" }
|
||||
point = { x = 1, y = 2 }
|
||||
animal = { type.name = \"pug\" }"))
|
||||
|
||||
(test-error "parse-toml: Invalid assignment to inline table"
|
||||
#t
|
||||
(parse-toml "[product]
|
||||
type = { name = \"Nail\" }
|
||||
type.edible = false # INVALID"))
|
||||
|
||||
;; We do not catch this semantic error yet.
|
||||
(test-expect-fail 1)
|
||||
(test-error "parse-toml: Invalid assignment to implicit table"
|
||||
#f
|
||||
(parse-toml "[product]
|
||||
type.name = \"Nail\"
|
||||
type = { edible = false } # INVALID"))
|
||||
|
||||
;; Not implemented.
|
||||
(test-expect-fail 1)
|
||||
(test-equal "parse-toml: Array of tables"
|
||||
'(("products" (("name" . "Hammer") ("sku" . 738594937))
|
||||
()
|
||||
(("name" . "Nail") ("sku" . 284758393) ("color" . "gray"))))
|
||||
(parse-toml "[[products]]
|
||||
name = \"Hammer\"
|
||||
sku = 738594937
|
||||
|
||||
[[products]] # empty table within the array
|
||||
|
||||
[[products]]
|
||||
name = \"Nail\"
|
||||
sku = 284758393
|
||||
|
||||
color = \"gray\""))
|
||||
|
||||
;; Not implemented.
|
||||
(test-expect-fail 1)
|
||||
(test-equal "parse-toml: Array of tables"
|
||||
'(("fruits" ((("name" . "apple")
|
||||
("physical" (("color" . "red") ("shape" . "round")))
|
||||
("varieties" ((("name" . "red delicious")) (("name" . "granny smith")))))
|
||||
(("name" . "banana")
|
||||
("varieties" (((("name" . "plantain")))))))))
|
||||
(parse-toml "[[fruits]]
|
||||
name = \"apple\"
|
||||
|
||||
[fruits.physical] # subtable
|
||||
color = \"red\"
|
||||
shape = \"round\"
|
||||
|
||||
[[fruits.varieties]] # nested array of tables
|
||||
name = \"red delicious\"
|
||||
|
||||
[[fruits.varieties]]
|
||||
name = \"granny smith\"
|
||||
|
||||
|
||||
[[fruits]]
|
||||
name = \"banana\"
|
||||
|
||||
[[fruits.varieties]]
|
||||
name = \"plantain\""))
|
||||
|
||||
;; Not implemented.
|
||||
(test-expect-fail 1)
|
||||
(test-error "parse-toml: Assignment to statically defined array"
|
||||
#f
|
||||
(parse-toml "fruits = []
|
||||
|
||||
[[fruits]]
|
||||
x=1"))
|
||||
|
||||
(test-end "toml")
|
||||
|
||||
Loading…
Reference in a new issue