Chicken/toml
1
0
Fork 0
Code Issues Pull requests Projects Releases 2 Packages Wiki Activity Actions

In the beginning there was darkness

Browse source
This commit is contained in:
Daniel Ziltener 2022-09-02 12:18:06 +02:00
commit 5dc271b32c
13 changed files with 512 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
.dir-locals.el Normal file
View file

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

12
.gitignore vendored Normal file
View file

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

3
.gitmodules vendored Normal file
View file

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

14
Makefile Normal file
View file

@ -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

7
tests/basic.toml Normal file
View file

@ -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

67
tests/run.scm Normal file
View file

@ -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")

3
tests/table.toml Normal file
View file

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

241
toml-impl.scm Normal file
View file

@ -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)))

16
toml.egg Normal file
View file

@ -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"))))

3
toml.release-info Normal file
View file

@ -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")

21
toml.scm Normal file
View file

@ -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")))

118
toml.wiki Normal file
View file

@ -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.

1
tomlc99 Submodule

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