In the beginning there was darkness

.dir-locals.el

@@ -0,0 +1,6 @@
+(
+ (scheme-mode . ((flycheck-scheme-chicken-args . ("-X" "r7rs" "-R" "r7rs" "-K" "prefix"))
+                 (geiser-scheme . chicken)
+                 (compile-command . "make salmonella")
+                 ))
+ )

.gitignore

@@ -0,0 +1,12 @@
+.DS_Store
+.idea
+*.log
+tmp/
+report/
+petri-dish/
+*.so
+*.o
+*.a
+*.sh
+*.import.scm
+*.link

.gitmodules

@@ -0,0 +1,3 @@
+[submodule "tomlc99"]
+	path = tomlc99
+	url = https://github.com/cktan/tomlc99

Makefile

@@ -0,0 +1,14 @@
+##
+# Toml
+#
+# @file
+# @version 0.1
+
+.PHONY: salmonella
+salmonella:
+	rm -rf report
+	rm -f toml*.so
+	salmonella --keep-repo --repo-dir=./petri-dish; \
+	salmonella-html-report ./salmonella.log report
+
+# end

tests/basic.toml

@@ -0,0 +1,7 @@
+name = "TOML"
+language = "Chicken Scheme"
+has-bool = true
+int = 5
+double = 10.8
+timestamp = 1979-05-27T07:32:00Z
+timezone = 1979-05-27T07:32:00-02:00

tests/run.scm

@@ -0,0 +1,67 @@
+(import (r7rs)
+        (scheme base)
+        (scheme write)
+        (srfi 64)
+        (srfi 152)
+        (rfc3339)
+        (toml))
+
+(define (tap-test-runner)
+  (let ((runner (test-runner-null))
+        (testcounter 0))
+    (display "TAP version 13\n")
+    (test-runner-on-test-end! runner
+      (lambda (runner)
+        (set! testcounter (+ testcounter 1))
+        (display
+         (string-append
+          (if (test-passed? runner) "ok " "not ok ")
+          (number->string testcounter) " - "
+          (string-join (test-runner-group-path runner) " - ")
+          " - " (test-runner-test-name runner)
+          (if (eq? 'skip (test-result-kind runner)) "# SKIP" "")
+          "\n"))))
+    (test-runner-on-final! runner
+      (lambda (runner)
+        (display (string-append "1.." (number->string testcounter) "\n"))))
+    runner))
+
+(test-runner-factory
+ (lambda () (tap-test-runner)))
+
+(test-begin "Basic")
+
+(let ((tdat (table-from-file "basic.toml")))
+  (test-equal 2 (toml-count-key-vals tdat))
+  (test-equal "TOML" (toml-string tdat "name"))
+  (test-equal "Chicken Scheme" (toml-string tdat "language"))
+  (test-equal #t (toml-bool tdat "has-bool"))
+  (test-equal 5 (toml-int tdat "int"))
+  (test-equal 10.8 (toml-double tdat "double"))
+  (test-equal (rfc3339->string (vector->rfc3339 #(1979 05 27 07 32 00 0 0)))
+    (rfc3339->string (toml-timestamp tdat "timestamp"))))
+
+(test-end "Basic")
+
+(test-begin "Table")
+
+(let ((tdat (table-from-file "table.toml")))
+  (test-equal 0 (toml-count-key-vals tdat))
+  (test-equal 1 (toml-count-tables tdat))
+  (let ((servertbl (toml-table tdat "server")))
+    (test-equal 1 (toml-count-key-vals servertbl))
+    (test-equal "www.example.com" (toml-string servertbl "host"))))
+
+(test-end "Table")
+
+(test-begin "Array")
+
+(let* ((tdat (table-from-file "table.toml"))
+       (tserv (toml-table tdat "server"))
+       (tarr (toml-array tserv "port")))
+  (test-equal 1 (toml-count-arrays tserv))
+  (test-equal 3 (toml-count-entries tarr))
+  (test-equal 8080 (toml-int tarr 0))
+  (test-equal 8282 (toml-int tarr 2)))
+
+(test-end "Array")

tests/table.toml

@@ -0,0 +1,3 @@
+[server]
+	host = "www.example.com"
+	port = [ 8080, 8181, 8282 ]

toml-impl.scm

@@ -0,0 +1,241 @@
+(import (chicken base)
+        scheme
+        (scheme base)
+        (srfi 69)
+        (chicken foreign)
+        (chicken memory)
+        (chicken gc)
+        (chicken format)
+        rfc3339
+        foreigners
+        coops
+        coops-primitive-objects)
+
+(foreign-declare "#include <toml.h>")
+
+(define (zeropad n)
+  (if (< n 10)
+      (sprintf "0~S" n)
+      (sprintf "~S" n)))
+
+(define (set-toml-table-finalizer ttable)
+  (set-finalizer! ttable
+                  (lambda (obj)
+                    ((foreign-lambda* void ((c-pointer ttp))
+                       "toml_free(ttp);")
+                     (ptr ttable)))))
+
+(define-class <TomlArray> ()
+  ((ptr :accessor ptr :initform #f)))
+
+(define-class <TomlTable> ()
+  ((ptr :accessor ptr :initform #f)))
+
+
+
+(define-method (toml-self-key (tarr <TomlArray>))
+  ((foreign-lambda* c-string ((c-pointer tarr))
+     "C_return(toml_array_key(tarr));")
+   (ptr tarr)))
+
+(define-method (toml-count-entries (tarr <TomlArray>))
+  ((foreign-lambda* int ((c-pointer tarr))
+     "C_return(toml_array_nelem(tarr));")
+   (ptr tarr)))
+
+(define-method (toml-string (tarr <TomlArray>) (index <integer>))
+  ((foreign-primitive ((c-pointer tarr)
+                       (int index))
+       "toml_datum_t datum = toml_string_at(tarr, index);"
+     "C_word* s = C_alloc(C_SIZEOF_STRING(strlen(datum.u.s)));"
+     "C_word data[3] = { C_SCHEME_UNDEFINED, C_k, C_string2(&s, datum.u.s) };"
+     "free(datum.u.s);"
+     "C_values(3, data);")
+   (ptr tarr) index))
+
+(define-method (toml-bool (tarr <TomlArray>) (index <integer>))
+  ((foreign-lambda* bool ((c-pointer tarr)
+                          (int index))
+     "C_return(toml_bool_at(tarr, index).u.b);")
+   (ptr tarr) index))
+
+(define-method (toml-int (tarr <TomlArray>) (index <integer>))
+  ((foreign-lambda* int ((c-pointer tarr)
+                         (int index))
+     "C_return(toml_int_at(tarr, index).u.i);")
+   (ptr tarr) index))
+
+(define-method (toml-double (tarr <TomlArray>) (index <integer>))
+  ((foreign-lambda* double ((c-pointer tarr)
+                            (int index))
+     "C_return(toml_double_at(tarr, index).u.d);")
+   (ptr tarr) index))
+
+(define-method (toml-timestamp (tarr <TomlArray>) (index <integer>))
+  (let*-values (((Y M D h m s millis z)
+                 ((foreign-primitive ((c-pointer tarr)
+                                      (int index))
+                      "toml_datum_t datum = toml_timestamp_at(tarr, index);"
+                    "toml_timestamp_t* stamp = datum.u.ts;"
+                    "C_word* s = C_alloc(C_SIZEOF_STRING(strlen(stamp->z)));"
+                    "C_word data[10] = { C_SCHEME_UNDEFINED, C_k, "
+                    "C_fix(stamp->year ? *stamp->year : 0), C_fix(stamp->month ? *stamp->month : 0), C_fix(stamp->day ? *stamp->day : 0), "
+                    "C_fix(stamp->hour ? *stamp->hour : 0), C_fix(stamp->minute ? *stamp->minute : 0),"
+                    "C_fix(stamp->second ? *stamp->second : 0), C_fix(stamp->millisec ? *stamp->second : 0), "
+                    "C_string2(&s, stamp->z ?: \"Z\") } ;"
+                    "free(datum.u.ts);"
+                    "C_values(10, data);")
+                  (ptr tarr) index))
+                ((rfcstr) (sprintf "~A-~A-~AT~A:~A:~A.~A~A"
+                                   Y (zeropad M) (zeropad D)
+                                   (zeropad h) (zeropad m) (zeropad s)
+                                   millis z)))
+    (string->rfc3339 rfcstr)))
+
+(define-method (toml-array (tarr <TomlArray>) (index <integer>))
+  (make <TomlArray> 'ptr
+        ((foreign-lambda* c-pointer ((c-pointer tarr)
+                                     (int index))
+           "C_return(toml_array_at(tarr, index));")
+         (ptr tarr) index)))
+
+(define-method (toml-table (tarr <TomlArray>) (index <integer>))
+  (make <TomlTable> 'ptr
+        ((foreign-lambda* c-pointer ((c-pointer tarr)
+                                     (int index))
+           "C_return(toml_table_at(tarr, index));")
+         (ptr tarr) index)))
+
+
+
+
+
+
+
+
+(define (table-from-file filename)
+  (let ((ttp ((foreign-lambda* c-pointer ((c-string fname))
+                "FILE* fp = fopen(fname, \"r\");"
+                "char errbuf[200];"
+                "toml_table_t* conf = toml_parse_file(fp, errbuf, sizeof(errbuf));"
+                "fclose(fp);"
+                "C_return(conf);")
+              filename)))
+    (when (not (eq? ttp 0))
+      (let ((tomltable (make <TomlTable> 'ptr ttp)))
+        (set-toml-table-finalizer tomltable)
+        tomltable))))
+
+(define (table-from-string str)
+  (let ((ttp ((foreign-lambda* c-pointer ((c-string confdata))
+                "char errbuf[200];"
+                "toml_table_t* conf = toml_parse(confdata, errbuf, sizeof(errbuf));"
+                "C_return(conf);")
+              str)))
+    (when (not (eq? ttp 0))
+      (let ((tomltable (make <TomlTable> 'ptr ttp)))
+        (set-toml-table-finalizer tomltable)
+        tomltable))))
+
+(define (set-toml-datum-string-finalizer tdatum)
+  (set-finalizer! tdatum
+                  (lambda (obj)
+                    ((foreign-lambda* void ((c-pointer tdat))
+                       "free(tdat);")
+                     (ptr tdatum)))))
+
+(define-method (toml-self-key (ttbl <TomlTable>))
+  ((foreign-lambda* c-string ((c-pointer ttbl))
+     "C_return(toml_table_key(ttbl));")
+   (ptr ttbl)))
+
+(define-method (toml-key-exists? (ttbl <TomlTable>) (key <string>))
+  (= 1
+     ((foreign-lambda* int ((c-pointer ttbl)
+                            (c-string key))
+        "C_return(toml_key_exists(ttbl, key));")
+      (ptr ttbl) key)))
+
+(define-method (toml-count-key-vals (ttbl <TomlTable>))
+  ((foreign-lambda* int ((c-pointer ttbl))
+     "C_return(toml_table_nkval(ttbl));")
+   (ptr ttbl)))
+
+(define-method (toml-count-arrays (ttbl <TomlTable>))
+  ((foreign-lambda* int ((c-pointer ttbl))
+     "C_return(toml_table_narr(ttbl));")
+   (ptr ttbl)))
+
+(define-method (toml-count-tables (ttbl <TomlTable>))
+  ((foreign-lambda* int ((c-pointer ttbl))
+     "C_return(toml_table_ntab(ttbl));")
+   (ptr ttbl)))
+
+(define-method (toml-key-at (ttbl <TomlTable>) (index <integer>))
+  ((foreign-lambda* c-string ((c-pointer ttbl)
+                              (int index))
+     "C_return(toml_key_in(ttbl, index));")
+   (ptr ttbl) index))
+
+(define-method (toml-string (ttbl <TomlTable>) (key <string>))
+  ((foreign-primitive ((c-pointer ttbl)
+                       (c-string key))
+       "toml_datum_t datum = toml_string_in(ttbl, key);"
+     "C_word* s = C_alloc(C_SIZEOF_STRING(strlen(datum.u.s)));"
+     "C_word data[3] = { C_SCHEME_UNDEFINED, C_k, C_string2(&s, datum.u.s) };"
+     "free(datum.u.s);"
+     "C_values(3, data);")
+   (ptr ttbl) key))
+
+(define-method (toml-bool (ttbl <TomlTable>) (key <string>))
+  ((foreign-lambda* bool ((c-pointer ttbl)
+                          (c-string key))
+     "C_return(toml_bool_in(ttbl, key).u.b);")
+   (ptr ttbl) key))
+
+(define-method (toml-int (ttbl <TomlTable>) (key <string>))
+  ((foreign-lambda* int ((c-pointer ttbl)
+                         (c-string key))
+     "C_return(toml_int_in(ttbl, key).u.i);")
+   (ptr ttbl) key))
+
+(define-method (toml-double (ttbl <TomlTable>) (key <string>))
+  ((foreign-lambda* double ((c-pointer ttbl)
+                            (c-string key))
+     "C_return(toml_double_in(ttbl, key).u.d);")
+   (ptr ttbl) key))
+
+(define-method (toml-timestamp (ttbl <TomlTable>) (key <string>))
+  (let*-values (((Y M D h m s millis z)
+                 ((foreign-primitive ((c-pointer ttbl)
+                                      (c-string key))
+                      "toml_datum_t datum = toml_timestamp_in(ttbl, key);"
+                    "toml_timestamp_t* stamp = datum.u.ts;"
+                    "C_word* s = C_alloc(C_SIZEOF_STRING(strlen(stamp->z)));"
+                    "C_word data[10] = { C_SCHEME_UNDEFINED, C_k, "
+                    "C_fix(stamp->year ? *stamp->year : 0), C_fix(stamp->month ? *stamp->month : 0), C_fix(stamp->day ? *stamp->day : 0), "
+                    "C_fix(stamp->hour ? *stamp->hour : 0), C_fix(stamp->minute ? *stamp->minute : 0),"
+                    "C_fix(stamp->second ? *stamp->second : 0), C_fix(stamp->millisec ? *stamp->second : 0), "
+                    "C_string2(&s, stamp->z ?: \"Z\") } ;"
+                    "free(datum.u.ts);"
+                    "C_values(10, data);")
+                  (ptr ttbl) key))
+                ((rfcstr) (sprintf "~A-~A-~AT~A:~A:~A.~A~A"
+                                   Y (zeropad M) (zeropad D)
+                                   (zeropad h) (zeropad m) (zeropad s)
+                                   millis z)))
+    (string->rfc3339 rfcstr)))
+
+(define-method (toml-array (ttbl <TomlTable>) (key <string>))
+  (make <TomlArray> 'ptr
+        ((foreign-lambda* c-pointer ((c-pointer ttbl)
+                                     (c-string key))
+           "C_return(toml_array_in(ttbl, key));")
+         (ptr ttbl) key)))
+
+(define-method (toml-table (ttbl <TomlTable>) (key <string>))
+  (make <TomlTable> 'ptr
+        ((foreign-lambda* c-pointer ((c-pointer ttbl)
+                                     (c-string key))
+           "C_return(toml_table_in(ttbl, key));")
+         (ptr ttbl) key)))

toml.egg

@@ -0,0 +1,16 @@
+;; -*- mode: scheme -*-
+((author "Daniel Ziltener")
+ (synopsis "A Chicken binding to read TOML configuration files")
+ (category parsing)
+ (license "MIT")
+ (version "0.5.0")
+ (dependencies r7rs rfc3339 coops)
+ (test-dependencies srfi-64 srfi-152)
+
+ (components
+  (c-object tomlc99/toml
+            (source "tomlc99/toml.c"))
+  (extension toml
+             (objects tomlc99/toml)
+             (csc-options "-X" "r7rs" "-R" "r7rs" "-K" "prefix" "-sJ"
+                          "-Itomlc99"))))

toml.release-info

@@ -0,0 +1,3 @@
+(repo git "https://gitea.lyrion.ch/zilti/toml.git")
+(uri targz "https://gitea.lyrion.ch/zilti/toml/archive/{egg-release}.tar.gz")
+(release "0.5")

toml.scm

@@ -0,0 +1,21 @@
+(import (r7rs))
+
+(define-library (toml)
+  (export table-from-file
+          table-from-string
+          toml-self-key
+          toml-count-entries
+          toml-count-key-vals
+          toml-count-arrays
+          toml-count-tables
+          toml-string
+          toml-bool
+          toml-int
+          toml-double
+          toml-timestamp
+          toml-array
+          toml-table
+          toml-key-exists?
+          toml-key-at)
+  (begin
+    (include "toml-impl.scm")))

toml.wiki

@@ -0,0 +1,118 @@
+[[tags: egg]]
+[[toc:]]
+== TOML
+A Chicken wrapper for the TOML configuration language
+
+=== Requirements
+
+[[/eggref/5/r7rs|r7rs]]
+[[/eggref/5/rfc3339|rfc3339]]
+[[/eggref/5/coops|coops]]
+
+=== Usage
+
+<enscript language=scheme>
+(import toml)
+</enscript>
+
+=== Loading TOML configuration
+
+<syntax>(table-from-file FILENAME) --> <TomlTable></syntax>
+
+Loads {{FILENAME}} contents as a TOML configuration.
+
+<syntax>(table-from-string STRING) --> <TomlTable></syntax>
+
+Loads the contents of {{STRING}} as TOML configuration.
+
+=== Tables
+
+<syntax>(toml-self-key TOMLTABLE) --> string</syntax>
+
+Returns the key, if any, to which {{TOMLTABLE}} is assigned.
+
+<syntax>(toml-key-exists? TOMLTABLE KEY) --> bool</syntax>
+
+Checks if {{KEY}} exists in {{TOMLTABLE}}.
+
+<syntax>(toml-count-key-vals TOMLTABLE) --> int</syntax>
+<syntax>(toml-count-arrays TOMLTABLE) --> int</syntax>
+<syntax>(toml-count-tables TOMLTABLE) --> int</syntax>
+
+Returns the number of key-value entries, arrays, or tables respectively in {{TOMLTABLE}}.
+
+<syntax>(toml-key-at TOMLTABLE INDEX) --> string</syntax>
+
+Returns the table key at position {{INDEX}} in {{TOMLTABLE}}.
+
+<syntax>(toml-string TOMLTABLE KEY) --> string</syntax>
+<syntax>(toml-bool TOMLTABLE KEY) --> bool</syntax>
+<syntax>(toml-int TOMLTABLE KEY) --> int</syntax>
+<syntax>(toml-double TOMLTABLE KEY) --> double</syntax>
+<syntax>(toml-timestamp TOMLTABLE KEY) --> rfc3339</syntax>
+<syntax>(toml-array TOMLTABLE KEY) --> <TomlArray></syntax>
+<syntax>(toml-table TOMLTABLE KEY) --> <TomlTable></syntax>
+
+Returns the element of the given type in {{TOMLTABLE}} at {{KEY}}.
+
+=== Arrays
+
+<syntax>(toml-self-key TOMLARRAY) --> string</syntax>
+
+Returns the key, if any, to which {{TOMLARRAY}} is assigned.
+
+<syntax>(toml-count-entries TOMLARRAY) --> int</syntax>
+
+Returns the number of entries in {{TOMLARRAY}}.
+
+<syntax>(toml-string TOMLARRAY KEY) --> string</syntax>
+<syntax>(toml-bool TOMLARRAY KEY) --> bool</syntax>
+<syntax>(toml-int TOMLARRAY KEY) --> int</syntax>
+<syntax>(toml-double TOMLARRAY KEY) --> double</syntax>
+<syntax>(toml-timestamp TOMLARRAY KEY) --> rfc3339</syntax>
+<syntax>(toml-array TOMLARRAY KEY) --> <TomlArray></syntax>
+<syntax>(toml-table TOMLARRAY KEY) --> <TomlTable></syntax>
+
+Returns the element of the given type in {{TOMLARRAY}} at {{KEY}}.
+
+== About this egg
+
+=== Authors
+Daniel Ziltener
+CK Tan
+
+=== Repository
+
+The repository of the Chicken wrapper can be found at [[https://gitea.lyrion.ch/zilti/toml|https://gitea.lyrion.ch/zilti/toml]].
+
+The repository of the C implementation being wrapped can be found at [[https://github.com/cktan/tomlc99|https://github.com/cktan/tomlc99]].
+
+=== Version History
+; 0.5 : first version of the wrapper
+
+=== License
+MIT License
+
+Copyright (c) Daniel Ziltener
+https://gitea.lyrion.ch/zilti/toml
+
+Copyright (c) CK Tan
+https://github.com/cktan/tomlc99
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

tomlc99

@@ -0,0 +1 @@
+Subproject commit e4107c455491925b8982c22df1ce37c0ccb7d4e4