blob: 6396d1ff979e75ad8311beea42be1490a2524f23 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
;;; guile-cloudformation --- Scheme DSL for CloudFormation templates
;;; Copyright © 2018 David Thompson <davet@gnu.org>
;;;
;;; Guile-CloudFormation 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.
;;;
;;; Guile-CloudFormation 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 this program. If not, see
;;; <http://www.gnu.org/licenses/>.
(use-modules (aws cloudformation utils)
(aws cloudformation utils json)
(ice-9 match)
(srfi srfi-1))
(define spec
(call-with-input-file "cloudformation-spec.json" read-json))
(define spec-version (assoc-ref spec "ResourceSpecificationVersion"))
(define properties-by-service (make-hash-table))
(define resources-by-service (make-hash-table))
(define (parse-service-name name)
(match (delete "" (string-split name #\:))
(("Tag") "Universal")
((_ service . _) service)))
(define (add-to-group table type-spec)
(match type-spec
((name . details)
(let* ((service (parse-service-name name))
(existing-stuff (or (hash-ref table service) '())))
(hash-set! table
service
(cons type-spec existing-stuff))))))
(for-each (lambda (property)
(add-to-group properties-by-service property))
(assoc-ref spec "PropertyTypes"))
(for-each (lambda (property)
(add-to-group resources-by-service property))
(assoc-ref spec "ResourceTypes"))
(define (hash-table-keys table)
(hash-fold (lambda (k v memo) (cons k memo)) '() table))
(define services
(sort (lset-union string=?
(hash-table-keys properties-by-service)
(hash-table-keys resources-by-service))
string<))
(for-each (lambda (service)
(let* ((module-suffix (symbol->string (aws-string->symbol service)))
(file-name (string-append "aws/cloudformation/"
module-suffix ".cfn")))
(display "create ")
(display file-name)
(newline)
(call-with-output-file file-name
(lambda (port)
(let ((properties (or (hash-ref properties-by-service service)
'()))
(resources (or (hash-ref resources-by-service service)
'())))
(write `(("ModuleSuffix" . ,module-suffix)
,@(if (string=? service "Universal")
`(("ResourceSpecificationVersion" .
,spec-version))
'())
("PropertyTypes" . ,properties)
("ResourceTypes" . ,resources))
port))))))
services)
|
