summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.gitignore10
-rw-r--r--Makefile.am31
-rw-r--r--aws/json.scm381
-rwxr-xr-xbootstrap3
-rw-r--r--configure.ac16
-rw-r--r--guix.scm12
-rw-r--r--pre-inst-env.in13
7 files changed, 466 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..b140771
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,10 @@
+*.go
+/Makefile
+/Makefile.in
+/aclocal.m4
+/config.log
+/config.status
+/configure
+/pre-inst-env
+/autom4te.cache
+/build-aux
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..58d1fed
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,31 @@
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files. See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_modDATA
+
+CLEANFILES = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+ $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
+
+moddir=$(prefix)/share/guile/site/$(GUILE_EFFECTIVE_VERSION)
+godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
+
+SOURCES = \
+ aws/json.scm \
+ aws/cloudformation/utils.scm \
+ language/cloudformation/spec.scm \
+ aws/cloudformation.json
+
+# aws/cloudformation.go: aws/cloudformation.json
+# echo hey
diff --git a/aws/json.scm b/aws/json.scm
new file mode 100644
index 0000000..cb77ff5
--- /dev/null
+++ b/aws/json.scm
@@ -0,0 +1,381 @@
+;;;; json.scm --- JSON reader/writer
+;;;; Copyright © 2015, 2017 David Thompson <davet@gnu.org>
+;;;; Copyright © 2017 Christopher Allan Webber <cwebber@dustycloud.org>
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3 of the License, or (at your option) any later version.
+;;;;
+;;;; This library 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
+;;;; Lesser General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this library; if not, write to the Free Software
+;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+;;;; 02110-1301 USA
+
+(define-module (aws json)
+ #:use-module (ice-9 match)
+ #:export (read-json write-json))
+
+(define (json-error port)
+ (throw 'json-error port))
+
+(define (assert-char port char)
+ "Read a character from PORT and throw an invalid JSON error if the
+character is not CHAR."
+ (unless (eqv? (read-char port) char)
+ (json-error port)))
+
+(define (whitespace? char)
+ "Return #t if CHAR is a whitespace character."
+ (char-set-contains? char-set:whitespace char))
+
+(define (consume-whitespace port)
+ "Discard characters from PORT until a non-whitespace character is
+encountered.."
+ (match (peek-char port)
+ ((? eof-object?) *unspecified*)
+ ((? whitespace?)
+ (read-char port)
+ (consume-whitespace port))
+ (_ *unspecified*)))
+
+(define (make-keyword-reader keyword value)
+ "Parse the keyword symbol KEYWORD as VALUE."
+ (let ((str (symbol->string keyword)))
+ (lambda (port)
+ (let loop ((i 0))
+ (cond
+ ((= i (string-length str)) value)
+ ((eqv? (string-ref str i) (read-char port))
+ (loop (1+ i)))
+ (else (json-error port)))))))
+
+(define read-true (make-keyword-reader 'true #t))
+(define read-false (make-keyword-reader 'false #f))
+(define read-null (make-keyword-reader 'null 'null))
+
+(define (read-hex-digit port)
+ "Read a hexadecimal digit from PORT."
+ (match (read-char port)
+ (#\0 0)
+ (#\1 1)
+ (#\2 2)
+ (#\3 3)
+ (#\4 4)
+ (#\5 5)
+ (#\6 6)
+ (#\7 7)
+ (#\8 8)
+ (#\9 9)
+ ((or #\A #\a) 10)
+ ((or #\B #\b) 11)
+ ((or #\C #\c) 12)
+ ((or #\D #\d) 13)
+ ((or #\E #\e) 14)
+ ((or #\F #\f) 15)
+ (_ (json-error port))))
+
+(define (read-utf16-character port)
+ "Read a hexadecimal encoded UTF-16 character from PORT."
+ (integer->char
+ (+ (* (read-hex-digit port) (expt 16 3))
+ (* (read-hex-digit port) (expt 16 2))
+ (* (read-hex-digit port) 16)
+ (read-hex-digit port))))
+
+(define (read-escape-character port)
+ "Read escape character from PORT."
+ (match (read-char port)
+ (#\" #\")
+ (#\\ #\\)
+ (#\/ #\/)
+ (#\b #\backspace)
+ (#\f #\page)
+ (#\n #\newline)
+ (#\r #\return)
+ (#\t #\tab)
+ (#\u (read-utf16-character port))
+ (_ (json-error port))))
+
+(define (read-string port)
+ "Read a JSON encoded string from PORT."
+ (assert-char port #\")
+ (let loop ((result '()))
+ (match (read-char port)
+ ((? eof-object?) (json-error port))
+ (#\" (list->string (reverse result)))
+ (#\\ (loop (cons (read-escape-character port) result)))
+ (char (loop (cons char result))))))
+
+(define char-set:json-digit
+ (char-set #\0 #\1 #\2 #\3 #\4 #\5 #\6 #\7 #\8 #\9))
+
+(define (digit? char)
+ (char-set-contains? char-set:json-digit char))
+
+(define (read-digit port)
+ "Read a digit 0-9 from PORT."
+ (match (read-char port)
+ (#\0 0)
+ (#\1 1)
+ (#\2 2)
+ (#\3 3)
+ (#\4 4)
+ (#\5 5)
+ (#\6 6)
+ (#\7 7)
+ (#\8 8)
+ (#\9 9)
+ (else (json-error port))))
+
+(define (read-digits port)
+ "Read a sequence of digits from PORT."
+ (let loop ((result '()))
+ (match (peek-char port)
+ ((? eof-object?)
+ (reverse result))
+ ((? digit?)
+ (loop (cons (read-digit port) result)))
+ (else (reverse result)))))
+
+(define (list->integer digits)
+ "Convert the list DIGITS to an integer."
+ (let loop ((i (1- (length digits)))
+ (result 0)
+ (digits digits))
+ (match digits
+ (() result)
+ ((n . tail)
+ (loop (1- i)
+ (+ result (* n (expt 10 i)))
+ tail)))))
+
+(define (read-positive-integer port)
+ "Read a positive integer with no leading zeroes from PORT."
+ (match (read-digits port)
+ ((0 . _)
+ (json-error port)) ; no leading zeroes allowed
+ ((digits ...)
+ (list->integer digits))))
+
+(define (read-exponent port)
+ "Read exponent from PORT."
+ (define (read-expt)
+ (list->integer (read-digits port)))
+
+ (unless (memv (read-char port) '(#\e #\E))
+ (json-error port))
+
+ (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\-
+ (read-char port)
+ (- (read-expt)))
+ (#\+
+ (read-char port)
+ (read-expt))
+ ((? digit?)
+ (read-expt))
+ (_ (json-error port))))
+
+(define (read-fraction port)
+ "Read fractional number part from PORT as an inexact number."
+ (let* ((digits (read-digits port))
+ (numerator (list->integer digits))
+ (denomenator (expt 10 (length digits))))
+ (/ numerator denomenator)))
+
+(define (read-positive-number port)
+ "Read a positive number from PORT."
+ (let* ((integer (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\0
+ (read-char port)
+ 0)
+ ((? digit?)
+ (read-positive-integer port))
+ (_ (json-error port))))
+ (fraction (match (peek-char port)
+ (#\.
+ (read-char port)
+ (read-fraction port))
+ (_ 0)))
+ (exponent (match (peek-char port)
+ ((or #\e #\E)
+ (read-exponent port))
+ (_ 0)))
+ (n (* (+ integer fraction) (expt 10 exponent))))
+
+ ;; Keep integers as exact numbers, but convert numbers encoded as
+ ;; floating point numbers to an inexact representation.
+ (if (zero? fraction)
+ n
+ (exact->inexact n))))
+
+(define (read-number port)
+ "Read a number from PORT"
+ (match (peek-char port)
+ ((? eof-object?)
+ (json-error port))
+ (#\-
+ (read-char port)
+ (- (read-positive-number port)))
+ ((? digit?)
+ (read-positive-number port))
+ (_ (json-error port))))
+
+(define (read-object port)
+ "Read key/value map from PORT."
+ (define (read-key+value-pair)
+ (let ((key (read-string port)))
+ (consume-whitespace port)
+ (assert-char port #\:)
+ (consume-whitespace port)
+ (let ((value (read-value port)))
+ (cons key value))))
+
+ (assert-char port #\{)
+ (consume-whitespace port)
+
+ (if (eqv? #\} (peek-char port))
+ (begin
+ (read-char port)
+ '()) ; empty object
+ (cons (read-key+value-pair)
+ (let loop ()
+ (consume-whitespace port)
+ (match (peek-char port)
+ (#\, ; read another value
+ (read-char port)
+ (consume-whitespace port)
+ (cons (read-key+value-pair) (loop)))
+ (#\} ; end of object
+ (read-char port)
+ '())
+ (_ (json-error port)))))))
+
+(define (read-array port)
+ "Read array from PORT."
+ (assert-char port #\[)
+ (consume-whitespace port)
+
+ (list->vector
+ (if (eqv? #\] (peek-char port))
+ (begin
+ (read-char port)
+ '() ); empty array
+ (cons (read-value port)
+ (let loop ()
+ (consume-whitespace port)
+ (match (peek-char port)
+ (#\, ; read another value
+ (read-char port)
+ (consume-whitespace port)
+ (cons (read-value port) (loop)))
+ (#\] ; end of array
+ (read-char port)
+ '())
+ (_ (json-error port))))))))
+
+(define (read-value port)
+ "Read a JSON value from PORT."
+ (consume-whitespace port)
+ (match (peek-char port)
+ ((? eof-object?) (json-error port))
+ (#\" (read-string port))
+ (#\{ (read-object port))
+ (#\[ (read-array port))
+ (#\t (read-true port))
+ (#\f (read-false port))
+ (#\n (read-null port))
+ ((or #\- (? digit?))
+ (read-number port))
+ (_ (json-error port))))
+
+(define (read-json port)
+ "Read JSON text from port and return an s-expression representation."
+ (let ((result (read-value port)))
+ (consume-whitespace port)
+ (unless (eof-object? (peek-char port))
+ (json-error port))
+ result))
+
+
+;;;
+;;; Writer
+;;;
+
+(define (write-string str port)
+ "Write STR to PORT in JSON string format."
+ (define (escape-char char)
+ (display (match char
+ (#\" "\\\"")
+ (#\\ "\\\\")
+ (#\/ "\\/")
+ (#\backspace "\\b")
+ (#\page "\\f")
+ (#\newline "\\n")
+ (#\return "\\r")
+ (#\tab "\\t")
+ (_ char))
+ port))
+
+ (display "\"" port)
+ (string-for-each escape-char str)
+ (display "\"" port))
+
+(define (write-object object port)
+ "Write ALIST to PORT in JSON object format."
+ ;; Keys may be strings or symbols.
+ (define key->string
+ (match-lambda
+ ((? string? key) key)
+ ((? symbol? key) (symbol->string key))))
+
+ (define (write-kv-pair key value)
+ (write-string (key->string key) port)
+ (display ":" port)
+ (write-json value port))
+
+ (display "{" port)
+ (match object
+ (() #f)
+ ((front ... (end-key end-val))
+ (for-each (match-lambda
+ ((key value)
+ (write-kv-pair key value)
+ (display "," port)))
+ front)
+ (write-kv-pair end-key end-val)))
+ (display "}" port))
+
+(define (write-array lst port)
+ "Write LST to PORT in JSON array format."
+ (display "[" port)
+ (match lst
+ (() #f)
+ ((front ... end)
+ (for-each (lambda (val)
+ (write-json val port)
+ (display "," port))
+ front)
+ (write-json end port)))
+ (display "]" port))
+
+(define (write-json exp port)
+ "Write EXP to PORT in JSON format."
+ (match exp
+ (#t (display "true" port))
+ (#f (display "false" port))
+ ('null (display "null" port))
+ ((? string? s) (write-string s port))
+ ((? real? n) (display n port))
+ (('@ . alist) (write-object alist port))
+ ((vals ...) (write-array vals port))))
diff --git a/bootstrap b/bootstrap
new file mode 100755
index 0000000..e756b42
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,3 @@
+#! /bin/sh
+
+autoreconf -vif
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..b0c3b56
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,16 @@
+dnl -*- Autoconf -*-
+
+AC_INIT(guile-cfn, 0.1.0)
+AC_CONFIG_SRCDIR(aws)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
+AM_SILENT_RULES([yes])
+
+AC_PATH_PROG([GUILE], [guile])
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+
+GUILE_PKG([3.0 2.2])
+GUILE_PROGS
+
+AC_OUTPUT
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..78a49bb
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,12 @@
+(use-modules (guix profiles)
+ (gnu packages autotools)
+ (gnu packages base)
+ (gnu packages guile)
+ (gnu packages pkg-config))
+
+(packages->manifest
+ (list autoconf
+ automake
+ gnu-make
+ guile-next
+ pkg-config))
diff --git a/pre-inst-env.in b/pre-inst-env.in
new file mode 100644
index 0000000..31c499d
--- /dev/null
+++ b/pre-inst-env.in
@@ -0,0 +1,13 @@
+#!/bin/sh
+
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
+
+GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
+GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
+export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
+
+PATH="$abs_top_builddir/scripts:$PATH"
+export PATH
+
+exec "$@"
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-21 14:01:50 +0000