guix: toml: Add TOML parser.

* guix/build/toml.scm: New file.
* tests/toml.scm: New file.
* Makefile.am: Register new files.

1 files changed, 442 insertions, 0 deletions

diff --git a/tests/toml.scm b/tests/toml.scm
new file mode 100644
index 0000000000..cd731cd2f0
--- /dev/null
+++ b/tests/toml.scm
@@ -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")
+