blob: 2bb32d8a129484c9df7003480da639da16c57b19 (
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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
|
;;; 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/>.
(define-module (aws cloudformation utils)
#:use-module (aws cloudformation utils base32)
#:use-module (aws cloudformation utils sha-1)
#:use-module (rnrs bytevectors)
#:export (aws-string->symbol
id->cfn-id))
(define (aws-string->symbol str)
;; Drop the "AWS::" that's at the beginning of *almost* everything.
(let ((str (if (string-prefix? "AWS::" str)
(string-drop str 5)
str)))
(list->symbol
(let loop ((i 0)
(same-word? #t)
(slash-delimiter? #f))
(cond
((= i (string-length str)) ; end of string
'())
;; "IoT" violates all the rules. grrrr
((and (< (+ i 3) (string-length str))
(eqv? (string-ref str i) #\I)
(eqv? (string-ref str (+ i 1)) #\o)
(eqv? (string-ref str (+ i 2)) #\T))
(cons* #\i #\o #\t (loop (+ i 3) #f #f)))
;; Replace "." with "/"
((eqv? (string-ref str i) #\.)
(cons #\/ (loop (1+ i) #f #t)))
;; Get rid of "::"
((and (eqv? (string-ref str i) #\:)
(eqv? (string-ref str (1+ i)) #\:))
(loop (+ i 2) #f #f))
((char-upper-case? (string-ref str i)) ; detect camel casing
(cond
;; If we've had a string of uppercase characters and the
;; next character is lowercase, we're actually at the
;; beginning of a new word. For example, when we reach the
;; "I" in "DBInstance" we need to treat it as the beginning
;; of a new word.
((and same-word?
(< (1+ i) (string-length str))
(char-lower-case? (string-ref str (1+ i))))
(loop i #f #f))
;; Consecutive uppercase characters are part of the same word.
(same-word?
(cons (char-downcase (string-ref str i)) (loop (1+ i) #t #f)))
;; Encountering an uppercase character after a series of
;; non-uppercase characters means that we are at the
;; beginning of a new word.
(else
(if (or (zero? i) slash-delimiter?)
(cons (char-downcase (string-ref str i)) (loop (1+ i) #t #f))
(cons* #\- (char-downcase (string-ref str i))
(loop (1+ i) #t #f))))))
(else
(cons (string-ref str i) (loop (1+ i) #f #f))))))))
(define char-set:alphanumeric
(char-set-intersection char-set:ascii char-set:letter+digit))
(define (alphanumize s)
(string-filter char-set:alphanumeric s))
(define (id->cfn-id sym)
(string-append (let ((camelized
(string-concatenate
(map (lambda (s)
(string-capitalize (alphanumize s)))
(string-split (symbol->string sym) #\-)))))
(if (> (string-length camelized) 223)
(substring camelized 223)
camelized))
(base32-encode
(sha-1->bytevector
(sha-1
(string->utf8
(symbol->string sym)))))))
|
